Binaryworld - NdxShellSort -Sort Indexed Arrays using ShellSort ... [ VB -> Arrays ]

' Indexed ShellSort of an array of any type
'
' Indexed Sorts are sort procedures that sort an index array
' instead of the main array. You can then list the items in
' sorted member by simply scanning the index, as in
' For i = 1 To numEls: Print arr(ndx(i)): Next
'
' NUMELS is the index of the last item to be sorted, and is
' useful if the array is only partially filled.
'
' Works with any kind of array, except UDTs and fixed-length
' strings, and including objects if your are sorting on their
' default property. String are sorted in case-sensitive mode.
'
' You can write faster procedures if you modify the first two lines
' to account for a specific data type, eg.
' Sub NdxShellSortS(arr() As Single, ndx() As Long,
' ' Optional numEls As Variant, Optional descending As Boolean)
' Dim value As Single

Sub NdxShellSort(arr As Variant, ndx() As Long, Optional numEls As Variant, _
  Optional descending As Boolean)

  Dim value As Variant
  Dim index As Long, index2 As Long
  Dim firstItem As Long
  Dim distance As Long
  Dim tempNdx As Long

  ' account for optional arguments
  If IsMissing(numEls) Then numEls = UBound(arr)
  firstItem = LBound(arr)
  ' init index array if necessary
  If ndx(firstItem) = 0 And ndx(UBound(ndx)) = 0 Then
    For index = firstItem To UBound(ndx)
      ndx(index) = index
    Next
  End If

  ' find the best value for distance
  Do
    distance = distance * 3 + 1
  Loop Until distance > numEls

  Do
    distance = distance \ 3
    For index = distance + 1 To numEls
      tempNdx = ndx(index)
      value = arr(tempNdx)
      index2 = index
      Do While (arr(ndx(index2 - distance)) > value) Xor descending
        ndx(index2) = ndx(index2 - distance)
        index2 = index2 - distance
        If index2 <= distance Then Exit Do
      Loop
      ndx(index2) = tempNdx
    Next
  Loop Until distance = 1
End Sub