VBA Collections

Hi,

I found some code (bottom of post) that sorts a collection by the field I request which works perfectly. The question I have is how to do this for two properties, i.e. by date then time?

Any help would be great.

Thanks

Mark
Private Function SortCollection(Col As Collection, psSortPropertyName As String, _
                                            pbAscending As Boolean, Optional psKeyPropertyName As String) As Collection

Dim obj As Object
Dim i As Integer
Dim j As Integer
Dim iMinMaxIndex As Integer
Dim vMinMax As Variant
Dim vValue As Variant
Dim bSortCondition As Boolean
Dim bUseKey As Boolean
Dim sKey As String
   
    bUseKey = (psKeyPropertyName <> "")
   
    For i = 1 To Col.Count - 1
        Set obj = Col(i)
        vMinMax = CallByName(obj, psSortPropertyName, VbGet)
        iMinMaxIndex = i
       
        For j = i + 1 To Col.Count
            Set obj = Col(j)
            vValue = CallByName(obj, psSortPropertyName, VbGet)
           
            If (pbAscending) Then
                bSortCondition = (vValue < vMinMax)
            Else
                bSortCondition = (vValue > vMinMax)
            End If
           
            If (bSortCondition) Then
                vMinMax = vValue
                iMinMaxIndex = j
            End If
           
            Set obj = Nothing
        Next j
       
        If (iMinMaxIndex <> i) Then
            Set obj = Col(iMinMaxIndex)
           
            Col.Remove iMinMaxIndex
            If (bUseKey) Then
                sKey = CStr(CallByName(obj, psKeyPropertyName, VbGet))
                Col.Add obj, sKey, i
            Else
                Col.Add obj, , i
            End If
           
            Set obj = Nothing
        End If
       
        Set obj = Nothing
    Next i
   
    Set SortCollection = Col
     
End Function
mcs26Asked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

ChloesDadCommented:
Hi,

Assuming that you add a second parameter psSortPropertyName2 then you can extend your check
I dont have VBA to be able to check the syntax, but it will give you the basis of what you need to do

 For i = 1 To Col.Count - 1
        Set obj = Col(i)
        vMinMax = CallByName(obj, psSortPropertyName, VbGet)
        vMinMax2 = CallByName(obj, psSortPropertyName2, VbGet)

        iMinMaxIndex = i
       
        For j = i + 1 To Col.Count
            Set obj = Col(j)
            vValue = CallByName(obj, psSortPropertyName, VbGet)
            vValue2 = CallbyName(obj,psSortPropertyName2,vbGet)
           
            If (pbAscending) Then
                IF vValue < vMinMax then
                   bSortCondition = TRUE
                ELSE IF vValue = vMINMax THEN
                   IF vValue2 < vMinMax2 then
                      bSortCondition = TRUE
                   ELSE
                      bSortCondition = FALSE
                   END IF
                ELSE
                     bSortCondition = FALSE
                END IF          
            Else
                IF vValue > vMinMax then
                   bSortCondition = TRUE
                ELSE IF vValue = vMINMax THEN
                   IF vValue2 > vMinMax2 then
                      bSortCondition = TRUE
                   ELSE
                      bSortCondition = FALSE
                   END IF
                ELSE
                     bSortCondition = FALSE
                END IF          
            End If
           
            If (bSortCondition) Then
                vMinMax = vValue
                vMinMax2 = vValue2
                 iMinMaxIndex = j
            End If
           
            Set obj = Nothing
        Next j
0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Visual Basic Classic

From novice to tech pro — start learning today.