4
\$\begingroup\$

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.

\$\endgroup\$

0

Browse other questions tagged or ask your own question.