Playing off Robust Bubble Sort in VBA and as suggested by @Henrik, I took a look at comb sort and tried to create an algorithm based on the documentation solely on Wikipedia.
Basically, the first procedure is just for the testing:
- Take a string of numbers and create an array
- Sort the array ascending or descending
- Build an output string and print it next to the input string
Sample input would look like this:
698 15 641 370 388 738 334 980 670 741 287 61 203 176 161 78 746 832 877 180 825 560 802 726 205 344 293 987 441 727 932 26 16 568 963 60 589 538 76 152 663 867 96 209 611 772 999 957 635 910 554 611 36 689 292 473 796 411 560 569 539 553 97 582 17 972 184 58 513 694 329 394 81 609 383 724 384 27 426 454 343 418 286 583 774 336 996 849 297 299
Option Explicit
Public Sub TestCombSort()
Const DELIMITER As String = " "
Dim targetSheet As Worksheet
Set targetSheet = ActiveSheet
Dim numberOfArrays As Long
numberOfArrays = targetSheet.Cells(targetSheet.Rows.Count, 1).End(xlUp).Row
Dim inputValue As String
Dim outputValue As String
Dim targetRow As Long
Dim index As Long
Dim rawArray As Variant
Dim numberArray() As Double
For targetRow = 1 To numberOfArrays
inputValue = targetSheet.Cells(targetRow, 1)
If Replace(inputValue, DELIMITER, vbNullString) = vbNullString Then GoTo NextIteration
rawArray = GetArrayFromCell(inputValue, DELIMITER)
'Create a sort for alphabetic strings? If so ->
'Create function to run only if numbers?
ReDim numberArray(LBound(rawArray) To UBound(rawArray))
For index = LBound(rawArray) To UBound(rawArray)
If Not IsNumeric(rawArray(index)) Then GoTo NextIteration
numberArray(index) = CDbl(rawArray(index))
Next
CombSortNumbers numberArray, False
outputValue = CreateOutputString(numberArray(), DELIMITER)
targetSheet.Cells(targetRow, 2) = outputValue
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 CombSortNumbers(ByRef numberArray() As Double, Optional ByVal sortAscending As Boolean = True)
Const SHRINK As Double = 1.3
Dim initialSize As Long
initialSize = UBound(numberArray())
Dim gap As Long
gap = initialSize
Dim index As Long
Dim isSorted As Boolean
Do While gap > 1 And Not isSorted
gap = Int(gap / SHRINK)
If gap > 1 Then
isSorted = False
Else
gap = 1
isSorted = True
End If
index = 0
Do While index + gap <= initialSize
If sortAscending Then
If numberArray(index) > numberArray(index + gap) Then
SwapElements numberArray, index, index + gap
isSorted = False
End If
Else
If numberArray(index) < numberArray(index + gap) Then
SwapElements numberArray, index, index + gap
isSorted = False
End If
End If
index = index + 1
Loop
Loop
End Sub
Private Sub SwapElements(ByRef numberArray() As Double, ByVal i As Long, ByVal j As Long)
Dim temporaryHolder As Double
temporaryHolder = numberArray(i)
numberArray(i) = numberArray(j)
numberArray(j) = temporaryHolder
End Sub
Private Function CreateOutputString(ByVal numberArray As Variant, ByVal DELIMITER As String) As String
Dim index As Long
For index = LBound(numberArray) To UBound(numberArray) - 1
CreateOutputString = CreateOutputString & numberArray(index) & DELIMITER
Next
CreateOutputString = CreateOutputString & numberArray(UBound(numberArray))
End Function
