by Chris Sebrell (1 Submission)
Category: Miscellaneous
Compatability: Visual Basic 5.0
Difficulty: Unknown Difficulty
Originally Published: Wed 27th March 2002
Date Added: Mon 8th February 2021
Rating: 
(1 Votes)
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()
VBcoders
'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