Visual Basic > Applications-VBA

Sorting the items in a collection

Sorting the items in a collection

The following routines demonstrate how to sort the items in a collection:

Option Explicit
Option Compare Text     'Remove this to make the sort case sensative


'Purpose   :    Sorts the values in a collection
'Inputs    :    oCollection                 The collection to sort the values of.
'               [bSortAscending]            If True sorts the values in ascending order,
'                                           else sort the values in descending order.
'Outputs   :    Returns zero on success, else returns an error number.
'Notes     :    The items in the sorted collection are not keyed.

Function CollectionSort(ByRef oCollection As Collection, Optional bSortAscending As Boolean = True) As Long
    Dim lSort1 As Long, lSort2 As Long
    Dim vTempItem1 As Variant, vTempItem2 As Variant, bSwap As Boolean
    
    On Error GoTo ErrFailed
    For lSort1 = 1 To oCollection.Count - 1
        For lSort2 = lSort1 + 1 To oCollection.Count
            If bSortAscending Then
                If oCollection(lSort1) > oCollection(lSort2) Then
                    bSwap = True
                Else
                    bSwap = False
                End If
            Else
                If oCollection(lSort1) < oCollection(lSort2) Then
                    bSwap = True
                Else
                    bSwap = False
                End If
            End If
            If bSwap Then
                'Store the items
                If VarType(oCollection(lSort1)) = vbObject Then
                    Set vTempItem1 = oCollection(lSort1)
                Else
                    vTempItem1 = oCollection(lSort1)
                End If
                
                If VarType(oCollection(lSort2)) = vbObject Then
                    Set vTempItem2 = oCollection(lSort2)
                Else
                    vTempItem2 = oCollection(lSort2)
                End If
                
                'Swap the items over
                oCollection.Add vTempItem1, , lSort2
                oCollection.Add vTempItem2, , lSort1
                'Delete the original items
                oCollection.Remove lSort1 + 1
                oCollection.Remove lSort2 + 1
            End If
        Next
    Next
    Exit Function

ErrFailed:
    Debug.Print "Error with CollectionSort: " & Err.Description
    CollectionSort = Err.Number
    On Error GoTo 0
End Function

'Demonstrates how to sort a collection containing the letters of the alphabet
Sub Test()
    Dim oCol As New Collection, lChar As Long
    'Populate a collection with the letters of the alphabet
    For lChar = 97 To 97 + 25
        oCol.Add Chr$(lChar)
    Next
    'Sort them in reverse order
    CollectionSort oCol, False
    'Display the results
    Debug.Print "-----------------------------"
    For lChar = 1 To 26
        Debug.Print oCol(lChar)
    Next
    'Sort them bacj
    CollectionSort oCol, True
    'Display the results
    Debug.Print "-----------------------------"
    For lChar = 1 To 26
        Debug.Print oCol(lChar)
    Next
End Sub