Custom Search

Friday, November 28, 2008

Simple collection sort method

Public Function SimpleSort(ByVal strSortBy As String, _
ByVal MainSort As Object) As Boolean

'On Error GoTo Hell

'Establish the Temp Collection
Dim ClonedCollection As Collection
Set ClonedCollection = New Collection

'Used for Sorting Loop
Dim SubSort As Object

'Bind the Object to the Collections Item Class
Set SubSort = MainSort

'******************Copy The Collection

'Copy the collection to a Temp Collection for sorting
For Each MainSort In mCol
ClonedCollection.Add MainSort
Next

'Erase it
Set mCol = Nothing

'Re-setup the New Collection
Set mCol = New Collection

'******************Add the Data Back in - Sorted

'Define Variables for the Sort Process
Dim lnth As Long 'Store the Collection Count
Dim strSortByMainSort As Variant 'Store the Value of the Main Sort Item

'Sorting by strSortBy String
For Each MainSort In ClonedCollection

'Store the Current value of the Main sort item
strSortByMainSort = CallByName(MainSort, strSortBy, VbGet)

'Set the current sorted collection count
lnth = mCol.Count

'Add First Item to Collection
If (lnth = 0) Then
mCol.Add MainSort
GoTo NextItem
End If

'Add Item After Last Item
Set SubSort = mCol.Item(lnth)
If (strSortByMainSort >= _
CallByName(SubSort, strSortBy, VbGet)) Then
mCol.Add MainSort, after:=lnth
GoTo NextItem
End If

'Insert in the middle of the collection
Dim nDx As Long: nDx = 1
For Each SubSort In mCol
If (strSortByMainSort < _
CallByName(SubSort, strSortBy, VbGet)) Then
mCol.Add MainSort, before:=nDx
GoTo NextItem
End If
nDx = nDx + 1
Next

NextItem:

'Debug.Print "Items Sorted: " & mCol.Count

Next

'Destroy the objects used
Set ClonedCollection = Nothing
Set SubSort = Nothing
Set MainSort = Nothing

SimpleSort = True

Exit Function

Hell:

'Destroy the objects used
Set ClonedCollection = Nothing
Set SubSort = Nothing
Set MainSort = Nothing

'Add Error Handling Here

SimpleSort = False

End Function

No comments: