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