Page tree
Skip to end of metadata
Go to start of metadata

Often you need to sort an array based on a key. This subroutine takes an array of "numberedStrings" and sorts it based on the string entry.

Option Explicit
Type numberedStrings
        s As String
        x As Double
End Type
Sub main
        Debug.Clear

        Dim ns(3) As numberedStrings

        ns(1).s = "aaa"
        ns(1).x = 300.5

        ns(2).s = "bbb"
        ns(2).x = 420

        ns(3).s = "ccc"
        ns(3).x = 191.12

        ShellSort(ns)

        Dim i As Integer

        For i = 1 To 3
                Debug.Print ns(i).s & " " & ns(i).x
        Next i
End Sub

Sub ShellSort(vArray As Variant)
    Dim TempVal As Variant
    Dim i As Long, GapSize As Long, CurPos As Long
    Dim FirstRow As Long, LastRow As Long, NumRows As Long
    FirstRow = LBound(vArray)
    LastRow = UBound(vArray)
    NumRows = LastRow - FirstRow + 1
    Do
      GapSize = GapSize * 3 + 1
    Loop Until GapSize > NumRows
    Do
      GapSize = GapSize \ 3
      For i = (GapSize + FirstRow) To LastRow
        CurPos = i
        TempVal = vArray(i)
        While IsLessThan(vArray(CurPos - GapSize),TempVal)
          vArray(CurPos) = vArray(CurPos - GapSize)
          CurPos = CurPos - GapSize
          If (CurPos - GapSize) < FirstRow Then Exit While
        Wend
        vArray(CurPos) = TempVal
      Next
    Loop Until GapSize = 1
End Sub
Function IsLessThan( Value1 As Variant, Value2 As Variant)
        IsLessThan = (Value1.x < Value2.x)
End Function