Robust Bubble Sort in VBA

Question

I'm creating a robust bubble sort for VBA when sorting stored arrays in VBA. Mostly this would be used when an array is stored in a single cell with a delimiter. Otherwise, one could just sort on the sheet during intake.

I'm trying to make this as robust as I can so it can be used as a tool rather than just continually rewriting it for each task when I need it. It can sort ascending or descending, the intention being that one may be able to use it to get minimums, maximums and medians.

I'd like to make it able to sort alphabetically, but right now it only sorts numbers. I mention this because I'd like to refactor the procedure that turns the variant array (hence the area with extra white space) into the double array, but I can't figure out an optimal way to do that without sending copies of arrays around, so it's just sitting in the TestBubbleSorting procedure right now. Any suggestions on that refactoring would be awesome.

Also, if the bubble sort method isn't the most robust sort algorithm to be using, I'd love to know that so I can try again.

Example input would be something like this

3
7,3,5
15,20,40
300,550,137

Option Explicit
Public Sub TestBubbleSorting()
 Const DELIMITER As String = ","
 Dim targetSheet As Worksheet
 Set targetSheet = ActiveSheet
 Dim numberOfArrays As Long
 numberOfArrays = targetSheet.Cells(1, 1)
 Dim rawArray As Variant
 Dim arrayToSort() As Double
 Dim targetRow As Long
 Dim targetElement As Long
 Dim numberOfElements As Long
 Dim inputValue As String
 Dim outputValue As String
 For targetRow = 2 To numberOfArrays + 1
 inputValue = targetSheet.Cells(targetRow, 1)
 If Replace(inputValue, DELIMITER, vbNullString) = vbNullString Then GoTo NextIteration
 rawArray = GetArrayFromCell(inputValue, DELIMITER)
 numberOfElements = UBound(rawArray) + 1
 ReDim arrayToSort(1 To numberOfElements)
 For targetElement = 0 To numberOfElements - 1
 arrayToSort(targetElement + 1) = CDbl(rawArray(targetElement))
 Next
 BubbleSortNumbers arrayToSort(), True
 For targetElement = 1 To numberOfElements - 1
 outputValue = outputValue & arrayToSort(targetElement) & DELIMITER
 Next
 outputValue = outputValue & arrayToSort(numberOfElements)
 targetSheet.Cells(targetRow, 2) = outputValue
 outputValue = vbNullString
NextIteration:
 Next
End Sub
Private Function GetArrayFromCell(ByVal inputValue As String, ByVal DELIMITER As String) As Variant
 GetArrayFromCell = Split(inputValue, DELIMITER)
End Function
Private Sub BubbleSortNumbers(ByRef arrayToSort() As Double, Optional ByVal sortAscending As Boolean = True)
 Dim temporaryHigher As Double
 Dim temporaryLower As Double
 Dim targetElement As Long
 Dim exchangeMade As Boolean
 If sortAscending Then
 Do
 exchangeMade = False
 For targetElement = 1 To UBound(arrayToSort) - 1
 If arrayToSort(targetElement) > arrayToSort(targetElement + 1) Then
 exchangeMade = True
 temporaryHigher = arrayToSort(targetElement)
 arrayToSort(targetElement) = arrayToSort(targetElement + 1)
 arrayToSort(targetElement + 1) = temporaryHigher
 End If
 Next targetElement
 Loop While exchangeMade
 Else
 Do
 exchangeMade = False
 For targetElement = UBound(arrayToSort) To 2 Step -1
 If arrayToSort(targetElement) > arrayToSort(targetElement - 1) Then
 exchangeMade = True
 temporaryLower = arrayToSort(targetElement)
 arrayToSort(targetElement) = arrayToSort(targetElement - 1)
 arrayToSort(targetElement - 1) = temporaryLower
 End If
 Next targetElement
 Loop While exchangeMade
 End If
End Sub

• user73941: I wonder why you emphasize that the algorithm must be robust in this context? What kind of data sets do you expect?
• Raystafarian: Maybe the better term would be versatile? Normally I'm encountering integers, but obviously I made it to handle decimals. I'm probably going to insert it into an add-in of tools that I collaborate on.
• Raystafarian: Seems this quicksort might be more efficient.
• user73941: Quicksort is definitely a better choise than bubblesort in most circumstances. If you are interested in sorting algoritms I think you may find combsort amazingly effective and yet almost as simple as bubblesort.
• Raystafarian: @HenrikHansen Thanks, tried a comb sort

Answer 1

In large I think the sort function is right out of the book of bubblesort.

IMO your naming is a little overdone. The long names are for an inexperienced eye hard to read.

The ascending and descending sort loops are essentially the same except for the direction of the comparation, so no need for backward loop or special temporary variables etc.

The swap mechanism calls for a swap function.

All in all find below a revised version of the sort function.

Private Sub Swap(vector() As Double, i As Long, j As Long)
 Dim tmp As Double
 tmp = vector(i)
 vector(i) = vector(j)
 vector(j) = tmp
End Sub
Private Sub BubbleSortNumbers(vector() As Double, Optional sortAscending As Boolean = True)
 Dim index As Long
 Dim isChanged As Boolean
 Dim first As Long
 Dim last As Long
 first = 1
 last = UBound(vector) - 1
 If sortAscending Then
 Do
 isChanged = False
 For index = first To last
 If vector(index) > vector(index + 1) Then
 isChanged = True
 Swap vector, index, index + 1
 End If
 Next index
 last = last - 1 ' The not yet positioned largest value "rabbits" down to its final position for every loop, so there is no need for checking it again.
 Loop While isChanged
 Else
 Do
 isChanged = False
 For index = first To last
 If vector(index) < vector(index + 1) Then
 isChanged = True
 Swap vector, index, index + 1
 End If
 Next index
 last = last - 1 
 Loop While isChanged
 End If
End Sub

All that said, bubble sort is not the most efficient algorithm, so if you have large data sets to sort I will suggest other more powerfull algorithms like quicksort, mergesort, heapsort or combsort where quicksort and combsort maybe are the easiest to implement (they are all well documented on Wikipedia).

• Jacob Manaker: Also, the new loops are very similar. Perhaps you can refactor them into one? (I'm thinking something like ...Dim direction As Integer = IIf(sortAscending, 1, -1) : Do : ... : If (vector(index)-vector(index+1))*direction > 0 Then : ...)
• user73941: @JacobManaker: Sure you could do something like that. But due to efficiency and readability I left it as two distinct loops, which I find OK for such a small algorithm. Further, the math you suggest only works for numeric values, so if you want to generalize to Variant or just to strings it is of no use.
• Raystafarian: Thanks for the feedback. Good idea on refactoring the swap and simplifying the two different loops with it.
• Raystafarian: I used a lot of your changes, thanks github
• user73941: @Raystafarian: Nice work :-)