# excel-vba function to filter an array and return an array

I have a function to filter a 2-d array.

It works. But I am not sure if the following mechanism is a sensible concept.

The idea is:

1. loop over the input array which is received as input_arr(y,x)

2. store the values in temp_arr(x,y), since in order to resize the y-dimension it needs to be last dimension, so I have to transpose the values as I store them

3. once the loop is done, transpose temp_arr(x,y) which becomes the return value

Public Function filter_arr(input_arr As Variant, col_index As Long, filter_value As Variant) As Variant

'the input_arr might be indexed starting from 0 or 1
Dim n1 As Long, n2 As Long
n1 = LBound(input_arr, 2)
n2 = UBound(input_arr, 2)

Dim temp_arr() As Variant
Dim y As Long, x As Long, count As Long
count = 0

If (LBound(input_arr, 1) = 0) Then
For y = LBound(input_arr, 1) To UBound(input_arr, 1)
If (input_arr(y, col_index) = filter_value) Then

ReDim Preserve temp_arr(n1 To n2, 0 To count)
For x = n1 To n2
temp_arr(x, count) = input_arr(y, x)
Next x
count = count + 1

End If
Next y

Else

'if LBound(input_arr, 1) = 1
For y = LBound(input_arr, 1) To UBound(input_arr, 1)

If (input_arr(y, col_index) = filter_value) Then

count = count + 1
ReDim Preserve temp_arr(n1 To n2, 1 To count)
For x = n1 To n2
temp_arr(x, count) = input_arr(y, x)
Next x

End If
Next y

End If

filter_arr = Application.Transpose(temp_arr)

End Function


Imagine that I have a ws in an .xlam file that contains product information which I've added as an add-in.

I have a function like =getProductData() which returns an array containing that data

So excel has a SORT function which works great with this kind of thing. I can do =SORT(getProductData(), 2, 1) to return my product data sorted by the 2nd column

But excel's FILTER function needs me to specify the data itself as its second parameter, not just its index, like in SORT

I can use INDEX to do something like =SORT(FILTER(getProductData(),INDEX(getProductData(),,3)="red",""),2,1) to filter my product data by the 3rd column if the value = red, then sort by the 2nd column of the resulting array

But I was hoping to do something like =SORT(filter_arr(getProductData(),3,"red"),2,1) to do the same

Naturally I'm still just playing around to determine what I can pull off - maybe using INDEX is the way to go and I'm trying to reinvent the wheel

• I would think about creating a class which provides the flexibility you want . I would suggest that internal to the class you convert the array to a collection of collections using either Collection, ArrayList or Scripting.Dictionary as your collection object (whichever is the best fit). Write methods or properties to expand/contract access individual items as required. Jan 12, 2021 at 11:25
• Just for some context, what is the purpose of this code; is it called from the worksheet as a UDF or from other vba code? What sort of data are you passing in, and is this just 1 step of a bigger process? Are you having performance issues? Update your question to include any of that sort of stuff if you can:) Jan 12, 2021 at 11:28
• I added some details of what my plans were for this function Jan 12, 2021 at 16:00
• Too short for a review, but VBA is slow and it's not too hard to make this work with spreadsheet formulae, but use LET or LAMBDA to avoid repeating the calculation: =LET(array,getProductData(),FILTER(array,INDEX(array,,3)="red")). Or better (but requires beta channel): FILTERIF = LAMBDA(array,filter_index,include_if,FILTER(array,INDEX(array,,filter_index) = include_if)) called like =FILTERIF(getProductData(),3,"red") Jan 13, 2021 at 16:33
• @Greedo Although I haven't used them, I believe that my answer would outperform Let and Lambda. In any case, not every version of Excel supports them. Jan 14, 2021 at 1:14

ReDim Preserve and Transpose are not free. I use this pattern when I need to filter an array:

1. Declare a 1-D array (Indices) with the same number of rows as the 2D array
2. When a match is found add the matches index to the Indices array and increment the counter
3. If there is matching data, declare a 2-D array (Results) with the same dimensions of the Input array but a row count equal to the counter
4. Iterate over the indices in the Indices array and add the matching values to the Results
5. Return the Results
6. If there are no matches return an empty array

## Quick Filter

Public Function QuickFilter(input_arr As Variant, col_index As Long, filter_value As Variant) As Variant
Dim r As Long
Dim Count As Long
Dim Indices As Variant
ReDim Indices(LBound(input_arr, 1) To UBound(input_arr, 1))
Count = LBound(input_arr, 1) - 1
For r = LBound(input_arr, 1) To UBound(input_arr, 1)
If input_arr(r, col_index) = filter_value Then
Count = Count + 1
Indices(Count) = r
End If
Next

Dim Results As Variant
Dim c As Long
Dim index As Long
If Count >= LBound(input_arr, 1) Then
 we want results to hold the entire row
ReDim Results(LBound(input_arr, 1) To Count, LBound(input_arr, 2) To UBound(input_arr, 2))
For r = LBound(input_arr, 1) To Count
index = Indices(r)
For c = LBound(input_arr, 2) To UBound(input_arr, 2)
Results(r, c) = input_arr(index, c)
Next
Next
QuickFilter = Results
Else
QuickFilter = Array()
End If
End Function

• I really examined this and it makes sense to me. 1. make indices w enough space in case every row hits 2. loop over input_array, storing the indices of input_array that hit, and recording count of hits. 3. make results w enough space to store count elements, 4. loop up to count populating results w rows from input_array corresponding to the values in incides. I'm still playing around with this but it feels like a good solution (or simple enough for me to understand). Feb 13, 2021 at 23:14
• I did a comparison using a dataset with 8000+ rows between a more elegant version of my function filter_arr and QuickFilter which showed QuickFilter was about 100 times faster. I guess the main point I have to accept is that looping over the data only once can look clean but redim is just such a speed bump that the code executes faster by replacing it with a combination of simpler operations. Feb 14, 2021 at 22:44
• @dactyrafficle The main thing to consider is redim preserve isn't free. It is much faster to reserve enough room in memory once (create a buffer) and then trim off the fat in the end. The same is true with strings. Feb 15, 2021 at 0:34

Based on my comment (and near terminal Covid-19 boredom) here is a starter for 10 for a class called 'FlexArray'. The code compiles cleanly and doesn't generate any untoward Rubberduck code inspections but is otherwise untested.

Usage is

Dim myArray as FlexArray
set myArray = FlexArray.Make(inputarray)


Note the Rubberduck annotations for PredeclaredId and Exposed. If you are unable to use the free and fantastic Rubberduck addin you will need to export the class to a text editor to set the relevant attributes.

'@PredeclaredId
'@Exposed
Option Explicit
' See https://excelmacromastery.com/vba-arraylist/

Private Type State

Data                    As ArrayList

End Type

Private s As State

Public Function Make(ByVal ipTable As Variant) As FlexArray

With New FlexArray

Set Make = .Self(ipTable)

End With

End Function

Public Function Self(ByVal ipTable As Variant) As FlexArray

Set s.Data = New ArrayList

Dim myRow As Long
For myRow = LBound(ipTable, 1) To UBound(ipTable, 1)

Dim myCol As Long
For myCol = LBound(ipTable, 2) To UBound(ipTable, 2)

Next

Next

Set Self = Me

End Function

Public Property Get Item(ByVal ipRow As Long, ByVal ipCol As Long) As Variant

Item = s.Data.Item(ipRow).Item(ipCol)

End Property

Public Property Let Item(ByVal ipRow As Long, ByVal ipCol As Long, ByVal ipValue As Variant)

s.Data.Item(ipRow).Item(ipCol) = ipValue

End Property

Public Function GetArrayRC() As Variant

Dim myTable As Variant
ReDim myTable(0 To s.Data.Count - 1, 0 To s.Data.Item(0).Count - 1)

Dim myRow As Long
For myRow = LBound(myTable, 1) To UBound(myTable, 1)

Dim myCol As Long
For myCol = LBound(myTable, 2) To UBound(myTable, 2)

myTable(myRow, myCol) = s.Data.Item(myRow).Item(myCol)

Next

Next

GetArrayRC = myTable

End Function

Public Function GetArrayCR() As Variant

Dim myTable As Variant
ReDim myTable(0 To s.Data.Item(0).Count - 1, 0 To s.Data.Count - 1)

Dim myRow As Long
For myRow = LBound(myTable, 2) To UBound(myTable, 2)

Dim myCol As Long
For myCol = LBound(myTable, 1) To UBound(myTable, 1)

myTable(myCol, myRow) = s.Data.Item(myCol).Item(myRow)

Next

Next

GetArrayCR = myTable

End Function

Public Sub InsertRow(ByVal ipRow As Long)

s.Data.Insert ipRow, New ArrayList

End Sub

Public Sub RemoveRow(ByVal ipRow As Long)

s.Data.RemoveAt ipRow

End Sub

Public Sub InsertCol(ByVal ipCol As Long, Optional ByVal ipColArray As Variant)

Dim myRow As Long
For myRow = 0 To s.Data.Count - 1

If myRow < UBound(ipColArray) Then

s.Data.Item(myRow).Insert ipCol, ipColArray(myRow)

Else

s.Data.Item(myRow).Insert ipCol, Empty

End If

Next

End Sub

Public Sub RemoveCol(ByVal ipCol As Long, Optional ByVal ipColArray As Variant)

Dim myRow As Long
For myRow = 0 To s.Data.Count - 1

s.Data.Item(myRow).RemoveAt ipCol

Next

End Sub

Public Property Get Row(ByVal ipRow As Long) As Variant
Row = s.Data.Item(ipRow).Clone
End Property

Public Property Let Row(ByVal ipRow As Long, ByVal ipRowArray As Variant)
' The .AddRange method cannot be used because ArrayList is a new object
' and expects an array that implements ICOllection
' VBA arrays do not implement ICOllection so the incoming array
' has to be added item by item

Dim myRowLen As Long
myRowLen = UBound(ipRowArray) - LBound(ipRowArray)

Dim myCol As Long
For myCol = 0 To s.Data.Item(ipRow).Count - 1

If myCol <= myRowLen Then

s.Data.Item(ipRow).Item(myCol) = ipRowArray(myCol)

Else

s.Data.Item(ipRow).Item(myCol) = Empty

End If

Next

End Property

Public Property Get Col(ByVal ipCol As Long) As Variant
Dim myCol As ArrayList
Set myCol = New ArrayList

Dim myRow As Long
For myRow = 0 To s.Data.Count - 1

Next

Col = myCol.Clone

End Property

Public Property Let Col(ByVal ipCol As Long, ByVal ipColArray As Variant)
' The .AddRange method cannot be used because ArrayList is a .Net object
' and expects an array that implements ICOllection
' VBA arrays do not implement ICOllection so the incoming array
' has to be added item by item

Dim myColLen As Long
myColLen = UBound(ipColArray) - LBound(ipColArray)

Dim myRow As Long
For myRow = 0 To s.Data.Count - 1

If myRow <= myColLen Then

s.Data.Item(myRow).Item(ipCol) = ipColArray(myRow)

Else

s.Data.Item(myRow).Item(ipCol) = Empty

End If

Next

End Property
`
• You have presented an alternative solution, but haven't reviewed the code. Please edit to show what aspects of the question code prompted you to write this version, and in what ways it's an improvement over the original. It may be worth (re-)reading How to Answer. Mar 25, 2021 at 16:21