How to filter an array using a sheet function?

Question

I am looking for a way to filter an array with a evaluated expression, for example:

Dim arr1(), arr2(), arr3() arr1 = Array(1, 2, 3, 4, 5) ' > [1, 2, 3, 4, 5] arr2 = Map(arr1, "Values() * 2") ' > [2, 4, 6, 8, 10] arr3 = Filter(arr2, "Values() > 6") ' > [8, 10] 

I have already implemented the Map function using UDF and Application.Evaluate("INDEX(expression, )") , but I try my best to make it work for Filter :

 Private arr_() Public Function Values() As Variant() Values = arr_ End Function Public Function Map(arr(), expression As String) As Variant() arr_ = arr Map = Application.Evaluate("INDEX(" & expression & ",)") End Function Public Function Filter(arr(), expression As String) As Variant() arr_ = arr Filter = Application.Evaluate("INDEX(Values(), " & expression & ")") End Function 

Is there a way besides looping or offsetting each value? VLOOKUP with VLOOKUP ?

Answer 1

Although I am a big fan of arrays and delegating most of my work with built-in Excel, for this I have found that it is most appropriate to do the main job in VBA using Excel's Evaluate expression for individual items.

 Public Function FilterArr(arr(), expression As String) Dim match As Boolean, i As Long, val ReDim ret(LBound(arr) To UBound(arr)) i = LBound(arr) - 1 On Error Resume Next For Each val In arr match = False match = Application.Evaluate(val & expression) If match Then i = i + 1 ret(i) = val End If Next If i >= LBound(arr) Then ReDim Preserve ret(LBound(arr) To i) FilterArr = ret End If End Function 

---

 Sub test() Dim arr1(), arr2(), arr3() arr1 = Array(10, 20, 30, 40, 50) arr3 = FilterArr(arr1, ">25") ' <--- usage like this ' arr3 = (30, 40, 50) End Sub 

ps an interesting extension would be the resolution of several criteria (i.e. AND ed together) using ParamArray . A good candidate for future work ...

Answer 2

First change the function to the following ...

 Public Function Filter(arr(), sValues As String, sCriteria As String) As Variant() Dim Cnt As Long arr_ = arr Cnt = Application.Evaluate("SUMPRODUCT(--(" & sValues & sCriteria & "))") If Cnt > 0 Then Filter = Application.Evaluate("TRANSPOSE(INDEX(SMALL(IF(" & sValues & sCriteria & "," & _ sValues & "),ROW(INDEX(A:A,1):INDEX(A:A," & Cnt & "))),0))") Else Filter = Array() End If End Function 

Then name it like this:

 arr3 = Filter(arr2, "Values()", ">6")