Sorting a Collection?

[fenris]

Say I have a collection of objects and I want to sort this collection based on a property of each of the objects, say a name property. How would I go about doing this?



Thanks in advance...

Troy Williams B.Eng.
fenris@hotmail.com

 

[JohnYingling]

Dim aryProp() as string
Dim aryX()    as long
Dim objX      as object
Dim objY      as object
Dim I         as long 
Dim J         as long 
'* Item 0 not used, will be ""
Redim aryProp(colX.Count)
I = 0
'* Get property into an array
For Each objX in colX
    I = I + 1
    aryProp(I) = objX.property
Next
'* Return array of indexes to original items in sorted order.
'* i.e. aryX(1) is index to first item in sequence
aryX = SortStrComp(aryProp(),1) ' Case insensitive (TextCompare)
Set ObjY = New collection
'* Copy 
J = Ubound(aryProp)
For I = 1 to J
    ... Add colx.Item(aryX(I)) to colY
Next
Set colX = colY 
Set colY = Nothing
......................    
Public Function SortStrComp(aryS() As String, Optional ByVal lngCompareType As CompareMethod) As Long()
    ' Sort the Array
    Dim lngN        As Long
    Dim lngGAP      As Long
    Dim I           As Long
    Dim J           As Long
    Dim JGap        As Long
    Dim lngI        As Long
    Dim lngIGap     As Long
    Dim lngBound    As Long
    Dim lngSwap     As Long
    Dim aryI()      As Long
       
    lngBound = UBound(aryS)
        
    lngN = UBound(aryS) + 1 ' Get Actual Count including 0
    ReDim aryI(lngBound) As Long
    For I = 0 To lngN - 1
        aryI(I) = I
    Next
    lngGAP = 1
    Do While (lngGAP < lngN)
        lngGAP = lngGAP * 3 + 1
    Loop
    lngGAP = (lngGAP - 1) \ 3
    
    Do While lngGAP > 0
        For I = lngGAP To lngN - 1
            JGap = I
            J = JGap - lngGAP
            Do While J >= 0
                lngI = aryI(J)
                lngIGap = aryI(JGap)
                                
                Select Case StrComp(aryS(lngI), aryS(lngIGap), lngCompareType)
                Case -1
                    Exit Do
                Case 0
                    If lngI <= lngIGap Then
                            Exit Do
                        End If
                End Select
                                
                aryI(J) = lngIGap
                aryI(JGap) = lngI
                
                JGap = J
                J = J - lngGAP
            Loop
        Next
        If lngGAP <= 1 Then Exit Do
        lngGAP = (lngGAP - 1) \ 3
    Loop
    
    SortStrComp = aryI
    Erase aryI
End Function

http://WWW.VBCompare.Com

 

[fenris]

Thanks, that is what I was looking for!




Troy Williams B.Eng.
fenris@hotmail.com