Shell Sort

Sub SortX(vArray)
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, 0)
TempIdx = vArray(i, 1)
Do While CompareResult(vArray(CurPos - GapSize, 0), TempVal)
vArray(CurPos, 0) = vArray(CurPos - GapSize, 0)
vArray(CurPos, 1) = vArray(CurPos - GapSize, 1)
CurPos = CurPos - GapSize
If (CurPos - GapSize) < FirstRow Then Exit Do
Loop
vArray(CurPos, 0) = TempVal
vArray(CurPos, 1) = TempIdx
Next
Loop Until GapSize = 1

End Sub
Function CompareResult(Value1 As Variant, Value2 As Variant)
' CompareResult = (Value1 > Value2)
CompareResult = (StrComp(Value1, Value2, vbTextCompare) = 1)
End Function