Previously: Comb Sort in VBA
I've been running two different comb sorts (on arrays) depending on whether I want to sort numbers or strings and I figured I would give using Variant
a try instead. source here.
Additionally, I wanted to sort 1- or 2- dimensional arrays on a specific key column, but keeping rows together.
So, this sorts 2D arrays based on a key column.
code:
Private Sub CombSortArray(ByRef dataArray As Variant, Optional ByVal numberOfColumns As Long = 1, Optional ByVal sortKeyColumn As Long = 1, Optional ByVal sortAscending As Boolean = True)
Const SHRINK As Double = 1.3
Dim initialSize As Long
initialSize = UBound(dataArray, 1)
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 = 1
Do While index + gap <= initialSize
If sortAscending Then
If dataArray(index, sortKeyColumn) > dataArray(index + gap, sortKeyColumn) Then
SwapElements dataArray, numberOfColumns, index, index + gap
isSorted = False
End If
Else
If dataArray(index, sortKeyColumn) < dataArray(index + gap, sortKeyColumn) Then
SwapElements dataArray, numberOfColumns, index, index + gap
isSorted = False
End If
End If
index = index + 1
Loop
Loop
End Sub
Private Sub SwapElements(ByRef dataArray As Variant, ByVal numberOfColumns As Long, ByVal i As Long, ByVal j As Long)
Dim temporaryHolder As Variant
Dim index As Long
For index = 1 To numberOfColumns
temporaryHolder = dataArray(i, index)
dataArray(i, index) = dataArray(j, index)
dataArray(j, index) = temporaryHolder
Next
End Sub
And my testing procedure -
Option Explicit
Public Sub TestCombSort()
Const SORT_KEY_COLUMN As Long = 1
Dim targetSheet As Worksheet
Set targetSheet = ActiveSheet
Dim dataArray As Variant
Dim lastRow As Long
lastRow = targetSheet.Cells(targetSheet.Rows.Count, 1).End(xlUp).Row
Dim lastColumn As Long
lastColumn = targetSheet.Cells(1, targetSheet.Columns.Count).End(xlToLeft).Column
dataArray = targetSheet.Range(targetSheet.Cells(1, 1), targetSheet.Cells(lastRow, lastColumn))
Dim index As Long
CombSortArray dataArray, lastColumn, SORT_KEY_COLUMN, True
targetSheet.Range(targetSheet.Cells(1, lastColumn + 1), targetSheet.Cells(lastRow, (lastColumn * 2))) = dataArray
End Sub
And some delimited sample data:
47,H,84
40,J,54
30,L,33
28,N,28
52,P,50
11,R,75
79,T,29
46,V,34
65,X,84
36,Z,42
5,bb,2
19,dd,81
25,ff,98
66,hh,96
65,kk,68
33,mm,80
63,oo,67
52,qq,22
Something I have noticed is that rubberduck is telling me both procedures can be functions, but I'm not sure why I would do that.