How to sort a collection in VBA

[Support]

We would like to share some standard code that we use in Arixcel when developing VBA or VB6 applications. Here is the first one - a procedure for sorting a collection of custom objects. It uses one of the fastest sorting algorighms with the efficiency of n * ln(n) (which is the best theoretically possible efficiency for sorting).

Code: Select all

Sub QuickSortSortableObjects(colSortable As Collection, Optional bSortAscending As Boolean = True, Optional iLow1, Optional iHigh1)
  Dim obj1 As Object
  Dim obj2 As Object
  Dim clsSortable As ISortableObject, clsSortable2 As ISortableObject
  Dim iLow2 As Long, iHigh2 As Long
  Dim dKey As Double
  On Error GoTo PtrExit
 
  'If not provided, sort the entire collection
  If IsMissing(iLow1) Then iLow1 = 1
  If IsMissing(iHigh1) Then iHigh1 = colSortable.Count

  'Set new extremes to old extremes
  iLow2 = iLow1
  iHigh2 = iHigh1

  'Get value of array item in middle of new extremes
  Set clsSortable = colSortable.Item((iLow1 + iHigh1) \ 2)
  dKey = clsSortable.dSortKey

  'Loop for all the items in the collection between the extremes
  Do While iLow2 < iHigh2

    If bSortAscending Then
      'Find the first item that is greater than the mid-point item
      Set clsSortable = colSortable.Item(iLow2)
      Do While clsSortable.dSortKey < dKey And iLow2 < iHigh1
        iLow2 = iLow2 + 1
        Set clsSortable = colSortable.Item(iLow2)
      Loop

      'Find the last item that is less than the mid-point item
      Set clsSortable2 = colSortable.Item(iHigh2)
      Do While clsSortable2.dSortKey > dKey And iHigh2 > iLow1
        iHigh2 = iHigh2 - 1
        Set clsSortable2 = colSortable.Item(iHigh2)
      Loop
    Else
      'Find the first item that is less than the mid-point item
      Set clsSortable = colSortable.Item(iLow2)
      Do While clsSortable.dSortKey > dKey And iLow2 < iHigh1
        iLow2 = iLow2 + 1
        Set clsSortable = colSortable.Item(iLow2)
      Loop

      'Find the last item that is greater than the mid-point item
      Set clsSortable2 = colSortable.Item(iHigh2)
      Do While clsSortable2.dSortKey < dKey And iHigh2 > iLow1
        iHigh2 = iHigh2 - 1
        Set clsSortable2 = colSortable.Item(iHigh2)
      Loop
    End If

    'If the two items are in the wrong order, swap the rows
    If iLow2 < iHigh2 And clsSortable.dSortKey <> clsSortable2.dSortKey Then
      Set obj1 = colSortable.Item(iLow2)
      Set obj2 = colSortable.Item(iHigh2)
      colSortable.Remove iHigh2
      If iHigh2 <= colSortable.Count Then _
        colSortable.Add obj1, Before:=iHigh2 Else colSortable.Add obj1
      colSortable.Remove iLow2
      If iLow2 <= colSortable.Count Then _
        colSortable.Add obj2, Before:=iLow2 Else colSortable.Add obj2
    End If

    'If the pointers are not together, advance to the next item
    If iLow2 <= iHigh2 Then
      iLow2 = iLow2 + 1
      iHigh2 = iHigh2 - 1
    End If
  Loop

  'Recurse to sort the lower half of the extremes
  If iHigh2 > iLow1 Then QuickSortSortableObjects colSortable, bSortAscending, iLow1, iHigh2

  'Recurse to sort the upper half of the extremes
  If iLow2 < iHigh1 Then QuickSortSortableObjects colSortable, bSortAscending, iLow2, iHigh1

PtrExit:
End Sub


Obviously, the procedure must be able to determine which object in the collection is "higher" and which is "lower". So there must be some some sorting key returned by the objects. This is achieved via a common interface, called ISortableObject, which all objects in the collection must implement. The only property of the interface is dSortKey of type Double.

Contents of the class module "ISortableObject":

Code: Select all

Option Explicit

'Get the key to use in the generic sorting routine
Public Property Get dSortKey() As Double
End Property


To implement the interface, you will need to put the right code in the ISortableObject_dSortKey() property in your particular class module (having "Implements ISortableObject" upfront).

The above sorting procedure is an adaptation of a QuickSort routine for a one-dimensional variant, which was published in the book Professional Excel Development. So the original credit goes to the authors of the book.