8
\$\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.

asked Nov 21, 2017 at 7:17
\$\endgroup\$
1
  • 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\$ Commented Jul 18, 2018 at 15:52

1 Answer 1

3
\$\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.

answered Mar 16, 2018 at 0:58
\$\endgroup\$
3
  • \$\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\$ Commented Mar 16, 2018 at 5:15
  • \$\begingroup\$ You are correct, comparers do return -1,0, or 1. \$\endgroup\$ Commented Mar 16, 2018 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\$ Commented Mar 16, 2018 at 7:16

Your Answer

Draft saved
Draft discarded

Sign up or log in

Sign up using Google
Sign up using Email and Password

Post as a guest

Required, but never shown

Post as a guest

Required, but never shown

By clicking "Post Your Answer", you agree to our terms of service and acknowledge you have read our privacy policy.