Sort

Description:
This class uses a shell sort algorithm to sort a collection object. It knows how to handle collections that contain numeric or textual string. For collections of other types of objects, you must implement it WithEvents, and respond to the IsLess function, and let the class know how the two objects compare.

11/23/2003: Added support for collections of objects.
 
Code:
'------------- Class: clsSort

Option Explicit

Public Event IsLess(obj1, obj2, bResult As Boolean)

Public Enum SortType
    SortNumeric
    SortString
    SortStringNoCase
    SortCustom
End Enum

'For the custom sort type, you must respond to the IsLess event,
' and set bResult accordingly
Public Sub Sort(col As Collection, _
   Optional nSort As SortType = SortNumeric)

    Dim i As Long
    Dim j As Long
    Dim nGap As Long
    Dim bResult As Boolean
    Dim bObject As Boolean
    
    Dim tmp
    Dim tmp2
    
    If IsObject(col.Item(1)) Then
        bObject = True
    End If
    
    nGap = col.Count / 2
    Do While nGap > 0
    
        For i = nGap To col.Count - 1
        
            If bObject Then
                Set tmp = col(i + 1)
            Else
                tmp = col(i + 1)
            End If
            j = i
            
            Select Case nSort
                Case SortCustom
                    RaiseEvent IsLess(tmp, col(j - nGap + 1), _
                       bResult)
                Case SortNumeric
                    bResult = (tmp < col(j - nGap + 1))
                Case SortString
                    bResult = (StrComp(tmp, col(j - nGap + 1), _
                       vbBinaryCompare) = -1)
                Case SortStringNoCase
                    bResult = (StrComp(tmp, col(j - nGap + 1), _
                       vbTextCompare) = -1)
            End Select
                
            Do While j >= nGap And bResult
            
                If bObject Then
                    Set tmp2 = col(j - nGap + 1)
                Else
                    tmp2 = col(j - nGap + 1)
                End If
                col.Remove j + 1
                If j + 1 > col.Count Then
                    col.Add tmp2
                Else
                    col.Add tmp2, , j + 1
                End If
            
                j = j - nGap
                If j >= nGap Then
                    Select Case nSort
                        Case SortCustom
                            RaiseEvent IsLess(tmp, col(j - nGap _
                               + 1), bResult)
                        Case SortNumeric
                            bResult = (tmp < col(j - nGap + 1))
                        Case SortString
                            bResult = (StrComp(tmp, col(j - nGap _
                               + 1), vbBinaryCompare) = -1)
                        Case SortStringNoCase
                            bResult = (StrComp(tmp, col(j - nGap _
                               + 1), vbTextCompare) = -1)
                    End Select
                End If
            Loop
            
            col.Remove j + 1
            If j + 1 > col.Count Then
                col.Add tmp
            Else
                col.Add tmp, , j + 1
            End If
        
        Next
    
        nGap = nGap / 2
    Loop

End Sub

'------------- End of class: clsSort
 
Sample Usage:
 
    Dim col As Collection
    Dim srtobj As clsSort
    
    Dim v
    Dim sString As String
    
    Set srtobj = New clsSort
    Set col = New Collection
    
    sString = "The quick red fox jumped over the lazy brown dogs."
    For v = 1 To Len(sString)
        col.Add Mid(sString, v, 1)
    Next
    
    For Each v In col
        Debug.Print v;
    Next
    Debug.Print
    
    srtobj.Sort col, SortStringNoCase
        
    For Each v In col
        Debug.Print v;
    Next
    Debug.Print