• Home
 · 
• Miscellaneous
 · 
• Sorts a VB Collection

Sorts a VB Collection

Sorts a VB Collection

API Declarations


'This contains 1 function to sort a VB Collection:
' Public Sub CM_SortCollection(ByRef theList As Collection)
'Included are two extra routines:
' Public Function CM_IsCollectionSorted(ByRef c As Collection) As Boolean
' Public Sub CM_SortCollectionTest()




Rate Sorts a VB Collection

• 1
• 2
• 3
• 4
• 5

(1(1 Vote))

    'Unfortunately, VB Collections are not really modifiable in the sense that it supports
    'very limited element moving.  You can only Add/Delete; there is no "Insert".  Hence this
    'function is not suitable for large collections.
    
    'This function will perform an O(n^2) sort on 'theList'
    'The general algorithm will be to find the smallest element in 'theList', remove it, and add it
    'to the end, then repeat while treating the list as if it were 1 element smaller (ignoring the
    '"smallest" elements at the end of the list.)
    
    Dim n As Long
    Dim k As Long
    Dim nSize As Long
    Dim k_min As Long       'Index of smallest element found
    
    'Get the full size of the list
    nSize = theList.Count
    
    If nSize < 2 Then
        Exit Sub
    End If
    
    'Main Passes
    For n = nSize To 2 Step -1
        'Assume first element is the smallest
        k_min = 1
        'Find smallest element in range [1,n]
        For k = 2 To n
            'Is element k smaller than element k_min ?
            If theList.Item(k) < theList.Item(k_min) Then
                'Yes, so k is the new min
                k_min = k
            End If
        Next k
        'Add element k_min to end of list, then remove it
        theList.Add theList.Item(k_min)
        theList.Remove k_min
    Next n
    
    'Now, element 1 is the largest, so move it to the top
    theList.Add theList.Item(1)
    theList.Remove 1
    
End Sub

Public Function CM_IsCollectionSorted(ByRef c As Collection) As Boolean

    Dim n As Long
    
    For n = 2 To c.Count
        If c.Item(n) < c.Item(n - 1) Then
            CM_IsCollectionSorted = False
            Exit Function
        End If
    Next n

    CM_IsCollectionSorted = True
    Exit Function
    
End Function

Public Sub CM_SortCollectionTest()

    Dim k As Long
    Dim c As New Collection
    
    c.Add "One"
    c.Add "Two"
    c.Add "Three"
    c.Add "Four"
    c.Add "Five"
    c.Add "Six"
    c.Add "Seven"
    c.Add "Eight"
    c.Add "Nine"
    c.Add "Ten"
    
    Debug.Print "COLLECTION:  (Sorted = " & CM_IsCollectionSorted(c) & ")"
    For k = 1 To c.Count
        Debug.Print "  Element(" & k & ") = '" & c.Item(k) & "'"
    Next k
    
    CM_SortCollection c
    
    Debug.Print "COLLECTION:  (Sorted = " & CM_IsCollectionSorted(c) & ")"
    For k = 1 To c.Count
        Debug.Print "  Element(" & k & ") = '" & c.Item(k) & "'"
    Next k
    
    Set c = Nothing

End Sub