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

Thanks for setting this question. I had been planning blog entries on using features from C# in VBA and this question prompted me. I have written a comprehensive blog entry on this topic. (I've even made a Youtube video discussing the solution's source code).

My offered solution is to use C# to write a Class Library DLL that does COM interop. It subclasses a Generic List, it also has a lambda expression parser so VBA code can pass a lambda into a Where method and get a filtered list.

You didn't give a class in your question for us to experiment with. So, I will give a class here called CartesianPoint which ships an Angle method and a Magnitude method which we can use the filter on. The class also implements IComparable so it can participate in sorting. The class implements an interface that is sufficient for it to run the lambda expressions.

Option Explicit

'written by S Meaden

Implements mscorlib.IComparable '* Tools->References->mscorlib
Implements LinqInVBA.ICartesianPoint


Dim PI

Public x As Double
Public y As Double

Public Function Magnitude() As Double
    Magnitude = Sqr(x * x + y * y)
End Function

Public Function Angle() As Double
    Angle = WorksheetFunction.Atan2(x, y)
End Function

Public Function AngleInDegrees() As Double
    AngleInDegrees = Me.Angle * (360 / (2 * PI))
End Function

Private Sub Class_Initialize()
    PI = 4 * Atn(1)
End Sub

Private Function ICartesianPoint_AngleInDegrees() As Double
    ICartesianPoint_AngleInDegrees = Me.AngleInDegrees
End Function

Private Function ICartesianPoint_Magnitude() As Double
    ICartesianPoint_Magnitude = Me.Magnitude
End Function

Private Property Get ICartesianPoint_ToString() As String
    ICartesianPoint_ToString = ToString
End Property

Private Function IComparable_CompareTo(ByVal obj As Variant) As Long
    Dim oPoint2 As CartesianPoint
    Set oPoint2 = obj
    IComparable_CompareTo = Sgn(Me.Magnitude - oPoint2.Magnitude)

End Function

Public Function ToString() As String
    ToString = "(" & x & "," & y & ")"
End Function

Public Function Equals(ByVal oPoint2 As CartesianPoint) As Boolean
    Equals = oPoint2.Magnitude = Me.Magnitude
End Function

Private Property Get IToStringable_ToString() As String
    IToStringable_ToString = ToString
End Property

Sample VBA client code is given by this test routine. SO highlights the lambda strings.

Public Sub TestObjects2()

    Dim oList As LinqInVBA.ListOfPoints
    Set oList = New LinqInVBA.ListOfPoints

    Dim o(1 To 3) As CartesianPoint
    Set o(1) = New CartesianPoint
    o(1).x = 3: o(1).y = 4

    Set o(2) = New CartesianPoint
    o(2).x = 0.25: o(2).y = 0.5
    Debug.Assert o(2).Magnitude <= 1

    Set o(3) = New CartesianPoint
    o(3).x = -0.25: o(3).y = 0.5
    Debug.Assert o(3).Magnitude <= 1


    oList.Add o(1)
    oList.Add o(2)
    oList.Add o(3)


    Debug.Print oList.ToString2 'prints (3,4),(0.25,0.5),(-0.25,0.5)
    oList.Sort
    Debug.Print oList.ToString2 'prints (-0.25,0.5),(0.25,0.5),(3,4)

    Dim oFiltered As LinqInVBA.ListOfPoints
    Set oFiltered = oList.Where("(o)=>o.Magnitude() <= 1")

    Debug.Print oFiltered.ToString2 'prints (-0.25,0.5),(0.25,0.5)

    Dim oFiltered2 As LinqInVBA.ListOfPoints
    Set oFiltered2 = oFiltered.Where("(o)=>o.AngleInDegrees()>=0 && o.AngleInDegrees()<=90")

    Debug.Print oFiltered2.ToString2 'prints (0.25,0.5)


'    Dim i
'    For i = 0 To oFiltered.Count - 1
'        Debug.Print oFiltered.Item(i).ToString
'    Next i

End Sub

The (shortened) C# code is given here

using System;
using System.Collections.Generic;
using System.Linq;
using System.Linq.Expressions;
using System.Runtime.InteropServices;
using myAlias = System.Linq.Dynamic;   //install package 'System.Linq.Dynamic' v.1.0.7 with NuGet

//https://stackoverflow.com/questions/49453260/datastructure-for-both-sorting-and-filtering/49453892
//https://www.codeproject.com/Articles/17575/Lambda-Expressions-and-Expression-Trees-An-Introdu
//https://stackoverflow.com/questions/821365/how-to-convert-a-string-to-its-equivalent-linq-expression-tree
//https://stackoverflow.com/questions/33176803/linq-dynamic-parselambda-not-resolving
//https://www.codeproject.com/Articles/74018/How-to-Parse-and-Convert-a-Delegate-into-an-Expres
//https://stackoverflow.com/questions/30916432/how-to-call-a-lambda-using-linq-expression-trees-in-c-sharp-net

namespace LinqInVBA
{
    // in project properties, build tab, check the checkbox "Register for Interop", run Visualstudio in admin so it can registers changes 
    // in AssemblyInfo.cs change to [assembly: ComVisible(true)]

    public class LambdaExpressionHelper
    {
        public Delegate ParseAndCompile(string wholeLambda, int expectedParamsCount, Type[] paramtypes)
        {
            string[] split0 = wholeLambda.Split(new string[] { "=>" }, StringSplitOptions.None);
            if (split0.Length == 1) { throw new Exception($"#Could not find arrow operator in expression {wholeLambda}!"); }
            if (split0.Length != 2) { throw new Exception($"#Expecting only single arrow operator not {split0.Length - 1}!"); }

            string[] args = split0[0].Trim().Split(new char[] { '(', ',', ')' }, StringSplitOptions.RemoveEmptyEntries);
            if (args.Length != expectedParamsCount) { throw new Exception($"#Paramtypes array is of different length {expectedParamsCount} to argument list length{args.Length}"); }
            var expression = split0[1];

            List<ParameterExpression> pList = new List<ParameterExpression>();

            for (int lArgLoop = 0; lArgLoop < args.Length; lArgLoop++)
            {
                Type typLoop = paramtypes[lArgLoop];
                var p = Expression.Parameter(typLoop, args[lArgLoop]);
                pList.Add(p);
            }


            var e = myAlias.DynamicExpression.ParseLambda(pList.ToArray(), null, expression);
            return e.Compile();
        }
    }

    public interface IFilterableListOfPoints
    {
        void Add(ICartesianPoint x);
        string ToString2();
        IFilterableListOfPoints Where(string lambda);

        int Count();
        ICartesianPoint Item(int idx);
        void Sort();
    }

    public interface ICartesianPoint
    {
        string ToString();
        double Magnitude();
        double AngleInDegrees();
        // add more here if you intend to use them in a lambda expression
    }

    [ClassInterface(ClassInterfaceType.None)]
    [ComDefaultInterface(typeof(IFilterableListOfPoints))]
    public class ListOfPoints : IFilterableListOfPoints
    {

        private List<ICartesianPoint> myList = new List<ICartesianPoint>();

        public List<ICartesianPoint> MyList { get { return this.myList; } set { this.myList = value; } }

        void IFilterableListOfPoints.Add(ICartesianPoint x)
        {
            myList.Add(x);
        }

        int IFilterableListOfPoints.Count()
        {
            return myList.Count();
        }

        ICartesianPoint IFilterableListOfPoints.Item(int idx)
        {
            return myList[idx];
        }

        void IFilterableListOfPoints.Sort()
        {
            myList.Sort();
        }

        string IFilterableListOfPoints.ToString2()
        {
            List<string> toStrings = new List<string>();
            foreach (ICartesianPoint obj in myList)
            {
                toStrings.Add(obj.ToString());
            }

            return string.Join(",", toStrings.ToArray());

        }

        IFilterableListOfPoints IFilterableListOfPoints.Where(string wholeLambda)
        {
            Type[] paramtypes = { typeof(ICartesianPoint) };


            LambdaExpressionHelper lh = new LambdaExpressionHelper();
            Delegate compiled = lh.ParseAndCompile(wholeLambda, 1, paramtypes);

            System.Func<ICartesianPoint, bool> pred = (System.Func<ICartesianPoint, bool>)compiled;

            ListOfPoints newList = new ListOfPoints();
            newList.MyList = (List<ICartesianPoint>)myList.Where(pred).ToList();
            return newList;
        }
    }
}

Answer 2

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 3

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.