The procedure for requesting AWR support has changed. Please read all about the new AWR product support process.
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