5
\$\begingroup\$

By implementing the MScorlib IComparer Interface, my PropertyComparer Class enables the sorting Objects added to an ArrayList by the their properties. You can also determine if an Object is in the ArrayList using a BinarySearch.

In order to do a BinarySearch you will need to sort the list with a PropertyComparer and then pass it to the the ArrayList.BinarySearch method.

This requires a MScorlib reference be set

There are a few nuances to consider when implementing MScorlib objects in the VBA.

  • Methods and properties of the MScorlib objects are not visible to IntelliSense or the Locals Window
  • Overloaded Methods are renamed. Generally, the first method in the MSDN documentation would be normal and the subsequent methods would be enumerated with an underscore

    • BinarySearch(Int32,Int32,Object,IComparer) -> BinarySearch(Long,Long,Object,IComparer)

    • BinarySearch(Object) => BinarySearch_2(Object)

    • BinarySearch(Object, IComparer) => BinarySearch_3(Object, IComparer)

In my demo I use ArrayList.Sort_2 pc and ArrayList.BinarySearch_3(Object, IComparer)


enter image description here

In this Demo I show how you can sort Ranges in an ArrayList by their various properties. The PropertyComparer is not limited to just Ranges; it can be applied to any Object whose 1st level property returns either a value or an Object that has a default value.

Class: PropertyComparer

Implements mscorlib.IComparer

Private mArgs As Variant
Private mCallType As VbCallType
Private mProcName As String

Public Function IComparer_Compare(ByVal X As Variant, ByVal Y As Variant) As Long
    Dim x1 As Variant, y1 As Variant
    If Len(mProcName) = 0 Then
        x1 = X
        y1 = Y
    Else
        x1 = CallFunction(X)
        y1 = CallFunction(Y)
    End If
    If TypeName(x1) = "String" Then
        IComparer_Compare = StrComp(x1, y1, vbTextCompare)
    Else
        If x1 > y1 Then
            IComparer_Compare = 1
        ElseIf x1 < y1 Then
            IComparer_Compare = -1
        End If
    End If
End Function

Public Sub Init(ProcName As String, CallType As VbCallType, ParamArray Args())
    mProcName = ProcName
    mCallType = CallType
    mArgs = Args
End Sub

' http://www.vbforums.com/showthread.php?405366-RESOLVED-Using-CallByName-with-variable-number-of-arguments
' Author: Joacim Andersson
Private Function CallFunction(Object As Variant)
    Select Case UBound(mArgs)
        Case -1
            CallFunction = CallByName(Object, mProcName, mCallType)
        Case 0
            CallFunction = CallByName(Object, mProcName, mCallType, Val(mArgs(0)))
        Case 1
            CallFunction = CallByName(Object, mProcName, mCallType, Val(mArgs(0)), Val(mArgs(1)))
        Case 2
            CallFunction = CallByName(Object, mProcName, mCallType, Val(mArgs(0)), Val(mArgs(1)), Val(mArgs(2)))
        Case 3
            CallFunction = CallByName(Object, mProcName, mCallType, Val(mArgs(0)), Val(mArgs(1)), Val(mArgs(2)), Val(mArgs(3)))
        Case 4
            CallFunction = CallByName(Object, mProcName, mCallType, Val(mArgs(0)), Val(mArgs(1)), Val(mArgs(2)), Val(mArgs(3)), Val(mArgs(4)))
    End Select
End Function

Userform1 Code

Public OrdersList As mscorlib.ArrayList
Private pc As PropertyComparer

Private Sub UserForm_Initialize()
    Dim cell As Range
    Set OrdersList = New ArrayList
    Set pc = New PropertyComparer

    With Worksheets("Orders")
        For Each cell In .Range("A2", .Range("A" & .Rows.count).End(xlUp))
            OrdersList.Add cell.Resize(1, 8)
        Next

        For Each cell In .Range("A1").Resize(1, 8)
            cboSortBy.AddItem cell.Value
        Next

    End With

    cboSortBy.AddItem "Row"

    FillOrdersListBox
End Sub

Private Sub btnFindCarmenSandiego_Click()
    Dim cell As Range
    OrdersList.Clear
    With Worksheets("Orders")
        For Each cell In .Range("A2", .Range("A" & .Rows.count).End(xlUp)).Resize(, 8)
            OrdersList.Add cell
        Next
    End With

    pc.Init "Address", VbGet, 0, 0, xlA1, -1
    OrdersList.Sort_2 pc
    FillOrdersListBox
    lboOrders.ColumnWidths = ""
    lboOrders.ListIndex = OrdersList.BinarySearch_3(Range("CarmenSandiego"), pc)
End Sub

Private Sub btnReverse_Click()
    OrdersList.Reverse
    FillOrdersListBox
End Sub

Private Sub cboSortBy_Change()
    If cboSortBy.ListIndex = -1 Then Exit Sub

    Select Case cboSortBy.ListIndex
        Case Is < 8
            pc.Init "Cells", VbGet, 1, cboSortBy.ListIndex + 1
        Case 8
            pc.Init "Row", VbGet
    End Select

    OrdersList.Sort_2 pc
    FillOrdersListBox
End Sub

Sub FillOrdersListBox()
    lboOrders.list = WorksheetFunction.Transpose(WorksheetFunction.Transpose(OrdersList.ToArray))
End Sub

Any advice on adding Comments, Error Handlers, or functionality would be appreciated.

\$\endgroup\$
  • 1
    \$\begingroup\$ A minor note would be to make the IComparer_Compare method Private; a user shouldn't need to see it alongside Init as they are unlikely to require it. And anything that does require it will already know the class implements IComparer - so this method really doesn't have to be Public at all \$\endgroup\$ – Greedo Jul 18 '18 at 15:52
0
\$\begingroup\$

The only thing I have to add here is that your documentation isn't the greatest.


Understanding that I need to reference mscorlib.Icomparer, the only .NET documentation I can find is https://msdn.microsoft.com/en-us/library/xh5ks3b3(v=vs.110).aspx which tells me Icomparer returns an integer.

So I read through your comments on that and noticed you are using some of the overloaded functions, but if I try to make that call I get an error. Because either the functions don't exist for me or I'm missing some other references.


I also note that Function CallFunction doesn't return a Type. I assume it's whatever CallByName returns, but again I can't see that.

What I do know is if I obj.Icomparer_Compare(obj1, obj2) I'm going to get one of three values (via the documentation) -

  -1: obj1   is less than      obj2    
   0: obj1   equals            obj2    
   1: obj1   is greater than   obj2

But, that's exactly what the code for the function is doing (and is also something easily written without a reference). So, why would you need to import the specific reference if it's only method is a method you've rewritten? That's how it looks to me.


I'm not entirely sure what types of arguments should be passed. I see this

pc.Init , VbGet, 0, 0, xlA1, -1

And look at the function

Public Sub Init(ProcName As String, CallType As VbCallType, ParamArray Args())
    mProcName = ProcName
    mCallType = CallType
    mArgs = Args
End Sub

And I can't tell at all why you're passing an Application.ReferenceStyle argument.


Now, maybe this would be more obvious to me if I had a table of data and a form setup, but as it stands, to me (just a regular ol' VBA guy), this needs more documentation to be a useful class to me.

\$\endgroup\$
  • \$\begingroup\$ Download Property Comparer.xlsm. Icomparer is an Interface used by mscorlib to compare items. I created this project to better understand the MSCorLib. CallFunction doesn't return a Type because it was meant to be as generic as possible. The PropertyComparer class is written in such a way that it could be used to compare any type of Object properties (Strings, Dates, Numbers...) . In practice I would write a class that implements the mscorlib.Icomparer interface to exact specifications of the Project. \$\endgroup\$ – user109261 Mar 16 '18 at 5:15
  • \$\begingroup\$ You are correct, comparers do return -1,0, or 1. \$\endgroup\$ – user109261 Mar 16 '18 at 5:17
  • \$\begingroup\$ All right, and as you said I can't actually see any of the function calls, so I can't imagine I'd have anything I could review further. \$\endgroup\$ – Raystafarian Mar 16 '18 at 7:16

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy