VBA code for numerical sort

Question

I am trying to sort a two dimensional array of numbers in VBA for Word.

I have been using the following code (I found it here:  http://oco-carbon.com/2012/08/13/sorting-functions-for-vba/ ) but sometimes it doesn't seem to sort the last value.

That is, if I have 5 values in the array, after the sort I sometimes find the 4th and 5th values are in the wrong order. Can anyone see why this would happen with this code? Or suggest alternative sort code that is not too slow and works for two dimensional arrays and works ascending and descending?

Function CombSort(TempArray As Variant, SortIndex As Long, Optional Descending As Boolean = False)

Dim Gap As Double

Dim Temp() As Variant

Dim Col As Long

Dim NoSwaps As Boolean

Dim i As Long

'Use this sub to sort arrays

ReDim Temp(0 To UBound(TempArray, 2))

Gap = UBound(TempArray)

Do Until Gap = 1 And NoSwaps

Gap = (Gap / 1.24733095010398)

If Gap < 1 Then

Gap = 1

End If

i = 0

NoSwaps = True

Do Until (i + Gap) >= UBound(TempArray)

If Descending And _

(TempArray(i, SortIndex) < TempArray(i + Gap, SortIndex)) Then

' Sort Z-A

For Col = 0 To UBound(TempArray, 2)

Temp(Col) = TempArray(i, Col)

TempArray(i, Col) = TempArray(i + Gap, Col)

TempArray(i + Gap, Col) = Temp(Col)

Next

NoSwaps = False

ElseIf Not Descending And _

(TempArray(i, SortIndex) > TempArray(i + Gap, SortIndex)) Then

' Sort A-Z

For Col = 0 To UBound(TempArray, 2)

Temp(Col) = TempArray(i, Col)

TempArray(i, Col) = TempArray(i + Gap, Col)

TempArray(i + Gap, Col) = Temp(Col)

Next

NoSwaps = False

End If

i = i + 1

Loop

Loop

CombSort = TempArray

End Function

Answer 1

Based on a code by John Korejwa:

Quicksort is the fastest known general sorting algorithm for large arrays.

However, once the number of elements in a partitioned subarray is smaller than some threshhold, Insertion Sort becomes faster.  So this code uses QuickSort for large subarrays, and Insertion Sort for small subarrays.

Quicksort is generally implemented recursively, but this code is non-recursive. To avoid recursion, a very simple Stack is used within the sorting procedure.

Andreas.

Option Explicit

Sub Test()

  Dim Data(0 To 9, 0 To 3), Temp

  Dim i As Integer, j As Integer

  For i = LBound(Data) To UBound(Data)

    For j = LBound(Data, 2) To UBound(Data, 2)

      Data(i, j) = Int(Rnd * 100)

    Next

  Next

  GoSub ShowData

  QuickSort2D_Prim Data, 0, msoSortOrderDescending

  GoSub ShowData

  Exit Sub

ShowData:

  Debug.Print

  ReDim Temp(LBound(Data, 2) To UBound(Data, 2))

  For i = LBound(Data) To UBound(Data)

    For j = LBound(Data, 2) To UBound(Data, 2)

      Temp(j) = Data(i, j)

    Next

    Debug.Print Join(Temp, ", ")

  Next

  Return

End Sub

Sub QuickSort2D_Prim(ByRef Liste, ByVal Index As Long, ByVal SortOrder As MsoSortOrder)

  Const QTHRESH As Long = 9

  Dim i As Long, j As Long, k As Long

  Dim Start As Long, Ende As Long

  Dim Pivot, Temp

  Dim Stack(1 To 64) As Long

  Dim StackPtr As Long

  Start = LBound(Liste)

  Ende = UBound(Liste)

  ReDim Temp(LBound(Liste, 2) To UBound(Liste, 2))

  Stack(StackPtr + 1) = Start

  Stack(StackPtr + 2) = Ende

  StackPtr = StackPtr + 2

  Do

    StackPtr = StackPtr - 2

    Start = Stack(StackPtr + 1)

    Ende = Stack(StackPtr + 2)

    If Ende - Start < QTHRESH Then

      'Insertionsort

      For j = Start + 1 To Ende

        For k = LBound(Liste, 2) To UBound(Liste, 2)

          Temp(k) = Liste(j, k)

        Next

        Pivot = Liste(j, Index)

        For i = j - 1 To Start Step -1

          If SortOrder = msoSortOrderAscending Then

            If Liste(i, Index) <= Pivot Then Exit For

          Else

            If Liste(i, Index) >= Pivot Then Exit For

          End If

          For k = LBound(Liste, 2) To UBound(Liste, 2)

            Liste(i + 1, k) = Liste(i, k)

          Next

        Next

        For k = LBound(Liste, 2) To UBound(Liste, 2)

          Liste(i + 1, k) = Temp(k)

        Next

      Next

    Else

      'QuickSort

      i = Start: j = Ende

      Pivot = Liste((Start + Ende) \ 2, Index)

      Do

        If SortOrder = msoSortOrderAscending Then

          Do While (Liste(i, Index) < Pivot): i = i + 1: Loop

          Do While (Liste(j, Index) > Pivot): j = j - 1: Loop

        Else

          Do While (Liste(i, Index) > Pivot): i = i + 1: Loop

          Do While (Liste(j, Index) < Pivot): j = j - 1: Loop

        End If

        If i <= j Then

          If i < j Then

            For k = LBound(Liste, 2) To UBound(Liste, 2)

              Temp(k) = Liste(i, k)

              Liste(i, k) = Liste(j, k)

              Liste(j, k) = Temp(k)

            Next

          End If

          i = i + 1: j = j - 1

        End If

      Loop Until i > j

      If (Start < j) Then

        Stack(StackPtr + 1) = Start

        Stack(StackPtr + 2) = j

        StackPtr = StackPtr + 2

      End If

      If (i < Ende) Then

        Stack(StackPtr + 1) = i

        Stack(StackPtr + 2) = Ende

        StackPtr = StackPtr + 2

      End If

    End If

  Loop Until StackPtr = 0

End Sub

Answer 2

Works perfectly now. Thanks very much!