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