Datastructure for both sorting and filtering

Question

Is there any data structure I have access to with efficient sorting and filtering of objects?

For sorting, the System.Collections.ArrayList is perfect, as I simply add a load of classes which Implement IComparable and .Sort(). However I can't find a .Filter() method, as some articles hint may be present (section 9.3).

Is there a good collection type for filtering and sorting custom objects? Preferably something written in a pre-compiled language.

---

A simple object would look like this:

Implements IComparable                           'requires mscorlib.dll, allows sorting

Public itemIndex As Long                        'simplest, sorting by an integer value

Private Function IComparable_CompareTo(ByVal obj As Variant) As Long
    'for sorting, itemindex is based on current grid sorting mode
    If TypeOf obj Is clsGridItem Then
        Dim other As clsGridItem: Set other = obj
        Dim otherIndex As Long: otherIndex = other.itemIndex
        Dim thisIndex As Long: thisIndex = Me.itemIndex
        If thisIndex > otherIndex Then
            IComparable_CompareTo = 1
        ElseIf thisIndex < otherIndex Then
            IComparable_CompareTo = -1
        Else
            IComparable_CompareTo = 0
        End If
    Else
        Err.Raise 5                              'obj is wrong type
    End If

End Function

And I have an arrayList of them populated with random indices. Of course anything could go in the compare routine (I actually use Select Case for different comparison routines, based on different properties of the classes). A simple filter loop could just check when IComparable_CompareTo = 0

Answer 1

Sort functionality is built-in to the ArrayList Objects, and Filtering is nothing more than "only using the items you need".

For example, this populates an object with random numbers and then filters results to display only those divisible by 42:

Option Explicit

Sub testSort()

    Const filter = 42
    Dim arr As Object, x As Long, y As Long
    Set arr = CreateObject("System.Collections.ArrayList")

    ' populate array with 100 random numbers
    For x = 1 To 420
        arr.Add Int(Rnd() * 10000)
    Next

    ' "sort" array
    arr.Sort

    ' dump array to immediate window; "filter" to show only even numbers
    For x = 0 To arr.Count - 1
        If arr(x) / filter = arr(x) \ filter Then
            'item mnatches filter
            Debug.Print "arr(" & x & ") = " & arr(x)
            y = y + 1
        End If
    Next x

    Debug.Print "Returned " & y & " sorted results (Filter=" & filter & ")"
End Sub

---

Other Possibilities

You haven't shared much detail on what you need to filter and how, but I was thinking about it further, and you might want to check these out to see if they can be applied to your task:

• MSDN: Filter Function (VBA)
  ^{Returns a zero-based array containing subset of a string array based on a specified filter criteria}

• excelfunctions.net: FILTER Function (VBA)

• MSDN: Filtering Items in a Collection (VBA)

• msdocs: CreateObject("System.Collections.ArrayList") (VB)
  ^{Filters the elements of an IEnumerable based on a specified type}

• msdocs: ArrayList Class Constructors (VB)

• Stack Overflow: How to implement class constructor in Visual Basic? (VB)

• Stack Overflow: VBA array sort function (VB/VBA)

• Wikipedia : Comparison of popular sorting algorithms

Answer 2

Arbitrary filtering of anything enumerable is something Enumerable.Where does, and it does it with the help of delegates, something VBA has no knowledge of, or ability to implement.

WARNING what follows is experimental code that is not intended for production use. It is provided as-is for educational purposes. Use at your own risk.

You can simulate it though. see Wait, is this... LINQ? and Generating and calling code on the fly on Code Review - below is a class I've called Delegate - note that it has its PredeclaredId attribute set to True, so that its Create factory method can be invoked from the default instance. It uses the Regular Expressions library for parsing the definition of the function, and the VBE Extensibility API library to literally generate an "anonymous function" given a string, for example:

Set x = Delegate.Create("(x) => MsgBox(""Hello, "" & x & ""!"")")
x.Execute "Mug"

The above code generates and invokes this function:

Public Function AnonymousFunction(ByVal x As Variant) As Variant
AnonymousFunction = MsgBox("Hello, " & x & "!")
End Function

Which produces what you would expect:

Delegate class

Option Explicit

Private Type TDelegate
    Body As String
    Parameters As New Collection
End Type

Private Const methodName As String = "AnonymousFunction"
Private this As TDelegate

Friend Property Get Body() As String
    Body = this.Body
End Property

Friend Property Let Body(ByVal value As String)
    this.Body = value
End Property

Public Function Create(ByVal expression As String) As Delegate

    Dim result As New Delegate

    Dim regex As New RegExp
    regex.Pattern = "\((.*)\)\s\=\>\s(.*)"

    Dim regexMatches As MatchCollection
    Set regexMatches = regex.Execute(expression)

    If regexMatches.Count = 0 Then
        Err.Raise 5, "Delegate", "Invalid anonymous function expression."
    End If

    Dim regexMatch As Match
    For Each regexMatch In regexMatches
        If regexMatch.SubMatches(0) = vbNullString Then

            result.Body = methodName & " = " & Right(expression, Len(expression) - 6)

        Else
            Dim params() As String
            params = Split(regexMatch.SubMatches(0), ",")

            Dim i As Integer
            For i = LBound(params) To UBound(params)
                result.AddParameter Trim(params(i))
            Next

            result.Body = methodName & " = " & regexMatch.SubMatches(1)

        End If

    Next

    Set Create = result

End Function

Public Function Execute(ParamArray params()) As Variant

    On Error GoTo CleanFail

    Dim paramCount As Integer
    paramCount = UBound(params) + 1

    GenerateAnonymousMethod
    'cannot break beyond this point

    Select Case paramCount

        Case 0
            Execute = Application.Run(methodName)
        Case 1
            Execute = Application.Run(methodName, params(0))
        Case 2
            Execute = Application.Run(methodName, params(0), params(1))
        Case 3
            Execute = Application.Run(methodName, params(0), params(1), params(2))
        Case 4
            Execute = Application.Run(methodName, params(0), params(1), params(2), _
                                                  params(3))
        Case 5
            Execute = Application.Run(methodName, params(0), params(1), params(2), _
                                                  params(3), params(4))
        Case 6
            Execute = Application.Run(methodName, params(0), params(1), params(2), _
                                                  params(3), params(4), params(5))
        Case 7
            Execute = Application.Run(methodName, params(0), params(1), params(2), _
                                                  params(3), params(4), params(5), _
                                                  params(6))
        Case 8
            Execute = Application.Run(methodName, params(0), params(1), params(2), _
                                                  params(3), params(4), params(5), _
                                                  params(6), params(7))
        Case 9
            Execute = Application.Run(methodName, params(0), params(1), params(2), _
                                                  params(3), params(4), params(5), _
                                                  params(6), params(7), params(8))
        Case 10
            Execute = Application.Run(methodName, params(0), params(1), params(2), _
                                                  params(3), params(4), params(5), _
                                                  params(6), params(7), params(8), _
                                                  params(9))

        Case Else
            Err.Raise 5, "Execute", "Too many parameters."

    End Select

CleanExit:
    DestroyAnonymousMethod
    Exit Function

CleanFail:
    Resume CleanExit
End Function

Friend Sub AddParameter(ByVal paramName As String)
    this.Parameters.Add "ByVal " & paramName & " As Variant"
End Sub

Private Sub GenerateAnonymousMethod()

    Dim component As VBComponent
    Set component = Application.VBE.VBProjects("Reflection").VBComponents("AnonymousCode")

    Dim params As String
    If this.Parameters.Count > 0 Then
        params = Join(Enumerable.FromCollection(this.Parameters).ToArray, ", ")
    End If

    Dim signature As String
    signature = "Public Function " & methodName & "(" & params & ") As Variant" & vbNewLine

    Dim content As String
    content = vbNewLine & signature & this.Body & vbNewLine & "End Function" & vbNewLine

    component.CodeModule.DeleteLines 1, component.CodeModule.CountOfLines
    component.CodeModule.AddFromString content

End Sub

Private Sub DestroyAnonymousMethod()

    Dim component As VBComponent
    Set component = Application.VBE.VBProjects("Reflection").VBComponents("AnonymousCode")

    component.CodeModule.DeleteLines 1, component.CodeModule.CountOfLines

End Sub

You'll want to change the VBProjects("Reflection").VBComponents("AnonymousCode") to point to some empty standard module in your VBA project... or have a project named Reflection with an empty standard module named AnonymousCode for the Execute method to generate the function into.

As an artifact of how VBA code is compiled, the generated code can be executed, but you can't place a breakpoint in it, and the VBE will refuse to break inside the generated code - so whatever string you supply the factory method with, you better be sure it's simple enough to be 100% bug-free.

What this gives you, is an object that encapsulates a specific action: this object can then be passed around as a parameter, like any other object - so if you have your own collection class implementation (here LinqEnumerable), then you can use it to implement a Where method that takes a Delegate parameter, assuming the predicate parameter encapsulates a function that returns a Boolean:

Public Function Where(ByVal predicate As Delegate) As LinqEnumerable
    Dim result As LinqEnumerable    
    Set result = New LinqEnumerable
    Dim element As Variant
    For Each element In encapsulated
        If predicate.Execute(element) Then result.Add element
    Next
    Set Where = result
End Function

So given that custom collection class, you can create a Delegate instance that defines your custom criteria, pass it to the Where method, and get the filtered results back.

You can even push it further and implement an Aggregate method:

Public Function Aggregate(ByVal accumulator As Delegate) As Variant
    Dim result As Variant    
    Dim isFirst As Boolean    
    Dim value As Variant
    For Each value In encapsulated
        If isFirst Then
            result = value
            isFirst = False
        Else
            result = accumulator.Execute(result, value)
        End If
    Next    
    Aggregate = result    
End Function

And run it pretty much as you would with C# LINQ, minus compile-time type safety and deferred execution:

Dim accumulator As Delegate
Set accumulator = Delegate.Create("(work,value) => value & "" "" & work")

Debug.Print LinqEnumerable.FromList(List.Create("the", "quick", "brown", "fox")) _
                          .Aggregate(accumulator)

Output:

fox brown quick the

---

This work was the basis of the Lambda stuff in the VBEX repository on GitHub (originally by Chris McClellan, co-founder of the Rubberduck project; most of the work can be credited to Philip Wales though) - a 100%-VBA project that gives you several other classes to play with. I'd encourage you to explore these and see if any of it is more appropriate for production use.