CODEWITHSUNDEEP
vbaexcel
michael
michael

Reputation: 949

How to filter an array with a worksheet function?

I'm looking for a way to filter an array with an evaluated expression such as:

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've already implemented the Map function with an UDF and with Application.Evaluate("INDEX(expression, )"), but I'm struggling 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 other than looping/shifting each value? Maby with VLOOKUP?

Upvotes: 5

Views: 1846

Answers (2)

Domenic
Domenic

Reputation: 8114

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 call it like this...

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

Upvotes: 1

A.S.H
A.S.H

Reputation: 29332

Although I am a big fan of arrays and delegating the most of the work to Excel's built-ins, for this one I found that the most appropriate is to do the main job in VBA, using Excel to Evaluate the 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

p.s. an interesting extension would be to permit multiple criteria (i.e. ANDed together) using a ParamArray. Good candidate for future work...

Upvotes: 1

Related Questions