html> QSortObjectCompare Example Procedure

Pearson Software Consulting Services

    Example QSortObjectCompare Function

         The QSortObjectsInPlace procedure requires a function that compares two objects and determines whether one object is "less than" or "greater than" another object. What this relationship actually means, how one object is "less than" another object, depends entirely on your specific needs and on the type of objects being compared. For example, if you have an array of references to Excel worksheets, these objects may be compared by using the value of a particular cell on each sheet, or by comparing the names of the sheets, or by using any other property you like. There is no general definition by which one object may be said to be "less than" or "greater than" another object of the same type.  Comparing two objects with an arithmetic comparison operator like "<" will result in a runtime error 438, "Object doesn't support this property or method." because the VBA is looking for a default property of each object.

The QSortObjectCompare function must be declared as follows:

Function QSortObjectCompare(Obj1 As Variant, Obj2 As Variant, _
    Optional CompareMode As VbCompareMethod = vbTextCompare) As Long

It should return one of the following values:
    -1 if Obj1 is "less than" Obj2
     0 if Obj1 is "equal to" Obj2
   +1 if Obj1 is "greater than" Obj2

In this example procedure, which you can download in a bas module file here, it is assumed that the objects are instances of a custom class that has a numeric property named "Value".  If both Obj1 and Obj2 are objects that are not Nothing, the Value property of the objects is compared and the result of that comparison is the result of the QSortObjectCompare function.

In this function, an object that is Nothing is considered to be less than anything else, including non-object type variables. This procedure first tests  whether Obj1 and Obj2 are in fact objects. If one is an object that is not Nothing and the other is not an object, the non-Nothing object is considered greater than the other non-Object variable. If one is an object that is Nothing and the other is a non-Object variable, the non-Object variable is considered greater the object that is Nothing. In other words, anything is greater than an object that is Nothing. If one is a non-Nothing object and the other is a non-Object variable, the Object is considered greater than the non-Object variable. In other words, Objects (that are not Nothing) are greater than non-Objects.

If both Obj1 and Obj2 are not objects, then each is tested with IsNumeric. If both variables pass the IsNumeric test, they are converted to Doubles and compared arithmetically. If either fails the IsNumeric test, both are converted to Strings and compared with the StrComp function, with the Compare Method (text or binary) specified in the CompareMode variable.

If both Obj1 and Obj2 are objects that are not Nothing, the the function reads the Value property of each object and does an arithmetic comparison of these Values.

The code for QSortObjectCompare is shown below.

Option Explicit
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' modQSortObjectCompare
' By Chip Pearson, www.cpearson.com, chip@cpearson.com
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' This module contains an example QSortObjectCompare function to be used as the comparison
' function for the QSortObjectsInPlace function. It assumes that Obj1 and Obj2 are
' instances of a custom class than has a Long-type Property named Value. This property
' is used to compare the objects. This function contains code to work with non-object
' variables.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Public Function QSortObjectCompare(Obj1 As Variant, Obj2 As Variant, _
    Optional CompareMode As VbCompareMethod = vbTextCompare) As Long
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' QSortObjectCompare
' This is an example of a QSortObjectCompare procedured used by
' QSortObjectsInPlace. It must return:
'       -1 if Obj1 is less than Obj2
'        0 if Obj1 is equal to Obj2
'       +1 if Obj1 is greater than Obj2
' The symbolic constants defined in this procedure can be used rather
' that actual numbers:
'        Const C_OBJECT1_LESS_THAN_OBJECT2 As Long = -1
'        Const C_OBJECT1_EQUALS_OBJECT2 As Long = 0
'        Const C_OBJECT1_GREATER_THAN_OBJECT2 As Long = 1
'
' Of course, the meanings of "less than", "equal to", and "greater than"
' will depend on what sort of objects are being sorted and the context
' in which they are used.
'
' If you know at design-time, when you are writing the code, what type
' of objects will be compared (this type and no other type), you can
' improve the performance of the sort by changing the Obj1 and Obj2
' declarations from "As Variant" to "As YourObjectType".
'
' Because Obj1 and Obj2 are declared as Variants, your code should
' test to ensure that both Obj1 and Obj2 are in fact objects. If either or
' both are not objects, the code should return the result you need in this
' situation. This example contains code in case either or both Obj1 and Obj2
' are not objects. If one is an object that is not Nothing and the other
' is not an object, then the Object is considered greater than the non-object.
' If one is an object that is Nothing and the other is not an object, then
' Nothing is considered less than a  non-object variable. An object that is
' Nothing is considered less than anything else. If both Obj1 and Obj2 are objects
' but both are Nothing, then they are considered equal. If neither are objects,
' then they are tested with IsNumeric. If both are numeric (including Strings
' that contain only numeric characaters), then they are converted to Doubles
' and compared arithmetically. If either or both fail the IsNumeric test, both
' are converted to Strings and compared using StrComp with the Compare Method
' (text or binary) as specified in the CompareMode parameter. In summary,
'
' 			Nothing < Non-Object < Object
'
' This example code assumes that each object is an instance of a custom class
' that has a numeric property named Value. This example compares the Value
' properties of Obj1 and Obj2 to see which is the greater.
'
' If you know at design time that Obj1 and Obj2 are ALWAYS (!) going to be
' Objects of a given type (or Nothing), and you do NOT want any testing for
' non-Object type variables, you can change the declarations of Obj1 and Obj2 from
' "As Variant" to "As YourObjectType" and you can delete all of the code
' that deals with non-object type variables. Delete the code between
' the
' '<<< NON-OBJECT TEST START
' and
' '<<< NON-OJBECT TEST END
' line markers.
' Removing this code increases your risk of failure if a non-object variable
' is in the array, but will increase the performance of the procedure.
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Const C_OBJECT1_LESS_THAN_OBJECT2 As Long = -1
Const C_OBJECT1_EQUALS_OBJECT2 As Long = 0
Const C_OBJECT1_GREATER_THAN_OBJECT2 As Long = 1

'<<< NON-OBJECT TEST START
Dim S1 As String ' used for string comparisons using StrComp of text data.
Dim S2 As String
Dim D1 As Double ' used for arithmetic comparison of numeric data.
Dim D2 As Double

'''''''''''''''''''''''''''''''''''''''''''''''''
' Test whether both Obj1 and Obj2 are objects.
' This entire IF structure deals with the
' situation when either or both Obj1 and Obj2
' are NOT objects. If both are objects,  the
' comparison is done in the code following this
' IF structure.
'''''''''''''''''''''''''''''''''''''''''''''''''
If IsObject(Obj1) = True Then
    If IsObject(Obj2) = False Then
        If Obj1 Is Nothing Then
            '''''''''''''''''''''''''''''''''''
            ' Obj1 is Nothing and Obj2 is not
            ' an object. Return -1 indicating
            ' Obj1 is less than Obj2.
            ''''''''''''''''''''''''''''''''''''
            QSortObjectCompare = C_OBJECT1_LESS_THAN_OBJECT2
            Exit Function
        Else
            '''''''''''''''''''''''''''''''''''''''''
            ' Obj1 is an object and is not Nothing
            ' and Obj2 is not an object. In this
            ' case Obj1 is greater than Obj2. Return
            ' +1 indicating Obj1 is greater than Obj2.
            ''''''''''''''''''''''''''''''''''''''''''
            QSortObjectCompare = C_OBJECT1_LESS_THAN_OBJECT2
            Exit Function
        End If
    Else
        ''''''''''''''''''''''''''''''''''''''''
        ' Both Obj1 and Obj2 are objects.
        ' Do nothing here. We'll do comparisons
        ' later.
        ''''''''''''''''''''''''''''''''''''''''
    End If
Else
    '''''''''''''''''''''''''''''''''''''''''''''''
    ' Obj1 is not an object.
    '''''''''''''''''''''''''''''''''''''''''''''''
    If IsObject(Obj2) = True Then
        '''''''''''''''''''''''''''''''''''''''''''
        ' Obj2 is an object. See if Obj2 is
        ' Nothing.
        '''''''''''''''''''''''''''''''''''''''''''
        If (Obj2 Is Nothing) Then
            '''''''''''''''''''''''''''''''''
            ' Obj1 is not an object and Obj2
            ' is Nothing. Return 1 indicating
            ' Obj1 > Obj2. Obj1 is always
            ' greater than Nothing.
            '''''''''''''''''''''''''''''''''
            QSortObjectCompare = C_OBJECT1_GREATER_THAN_OBJECT2
            Exit Function
        Else
            '''''''''''''''''''''''''''''''''''''''
            ' Obj1 is not an object and Obj2
            ' is not Nothing. Return -1 indicating
            ' Obj1 < Obj2. An Object that is not
            ' Nothing is always greater than a
            ' non-object variable.
            '''''''''''''''''''''''''''''''''''''''
            QSortObjectCompare = C_OBJECT1_LESS_THAN_OBJECT2
            Exit Function
        End If
    Else
        ''''''''''''''''''''''''''''''''''''''''''
        ' Obj1 is not an object and Obj2 is not
        ' an object. If both Obj1 and Obj2 are
        ' numeric, then convert to Doubles and
        ' do an arithmetic compare.
        ''''''''''''''''''''''''''''''''''''''''''
        If (IsNumeric(Obj1) = True) And (IsNumeric(Obj2) = True) Then
            ''''''''''''''''''''''''''''''''''''''
            ' Both Obj1 and Obj2 are numeric. Do
            ' arithmetic comparisons.
            ''''''''''''''''''''''''''''''''''''''
            D1 = CDbl(Obj1)
            D2 = CDbl(Obj2)
            If D1 < D2 Then
                QSortObjectCompare = C_OBJECT1_LESS_THAN_OBJECT2
                Exit Function
            End If
            If D1 = D2 Then
                QSortObjectCompare = C_OBJECT1_EQUALS_OBJECT2
                Exit Function
            End If
            If D1 > D2 Then
                QSortObjectCompare = C_OBJECT1_GREATER_THAN_OBJECT2
                Exit Function
            End If
        Else
            ''''''''''''''''''''''''''''''''''''''''''''''''''''
            ' Either Obj1 or Obj2 is not numeric. Convert both
            ' objects to Strings and use StrComp to compare the
            ' strings.
            ''''''''''''''''''''''''''''''''''''''''''''''''''''
            S1 = CStr(Obj1)
            S2 = CStr(Obj2)
            QSortObjectCompare = StrComp(S1, S2, CompareMode)
            Exit Function
        End If
    End If
End If
'<<< NON-OJBECT TEST END
                
'''''''''''''''''''''''''''''''''''''''''''''''''
' If we make it this far, we know that BOTH Obj1
' and Obj2 are objects.
''''''''''''''''''''''''''''''''''''''''''''''''
If (Obj1 Is Nothing) And (Obj2 Is Nothing) Then
    '''''''''''''''''''''''''''''''''''''''''''''''''
    ' If both Obj1 and Obj2 are Nothing, then return
    ' 0 indicating they are equal. Nothings are
    ' always equal.
    '''''''''''''''''''''''''''''''''''''''''''''''''
    QSortObjectCompare = C_OBJECT1_EQUALS_OBJECT2
    Exit Function
End If
'''''''''''''''''''''''''''''''''''''''''''''''''
' If Obj1 is NOT Nothing and Obj2 is Nothing,
' then return 1. Any object that is not Nothing
' is greater than any object that is Nothing.
'''''''''''''''''''''''''''''''''''''''''''''''''
If (Not Obj1 Is Nothing) And (Obj2 Is Nothing) Then
    QSortObjectCompare = C_OBJECT1_GREATER_THAN_OBJECT2
    Exit Function
End If
'''''''''''''''''''''''''''''''''''''''''''''''''
' If Obj1 is Nothing and Obj2 is not Nothing,
' then return -1. Any object that is Nothing
' is less than any object that is not Nothing.
'''''''''''''''''''''''''''''''''''''''''''''''''
If (Obj1 Is Nothing) And (Not Obj2 Is Nothing) Then
    QSortObjectCompare = C_OBJECT1_LESS_THAN_OBJECT2
    Exit Function
End If

''''''''''''''''''''''''''''''''''''''''''''''''
' At this point, we know that both Obj1 and
' Obj2 are not Nothing. In this example, we
' assume that the objects have a numeric
' Property named "Value". We will compare the
' Value property and return a result.
''''''''''''''''''''''''''''''''''''''''''''''''

''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''
' This is the actual comparison code for
' object type variables. Change the .Value
' property to the property of the object
' that you are going to use in comparing
' two objects. There is no limitation on
' the property or attribute you use to
' compare the objects, other than the obvious
' factor that both objects must support that
' property.
''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''
    If Obj1.Value < Obj2.Value Then
        QSortObjectCompare = C_OBJECT1_LESS_THAN_OBJECT2
        Exit Function
    End If
    If Obj1.Value = Obj2.Value Then
        QSortObjectCompare = C_OBJECT1_EQUALS_OBJECT2
        Exit Function
    End If
    If Obj1.Value > Obj2.Value Then
        QSortObjectCompare = C_OBJECT1_GREATER_THAN_OBJECT2
        Exit Function
    End If
End Function

 

 
     
     

 

Created By Chip Pearson and Pearson Software Consulting, LLC 
This Page:                Updated: November 06, 2013     
MAIN PAGE    About This Site    Consulting    Downloads  
Page Index     Search    Topic Index    What's New    Links   Legalese And Disclaimers
chip@cpearson.com

© Copyright 1997-2007  Charles H. Pearson