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

Question

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
   

Edit: adding some context

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

Answer 1

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

Answer 2

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)

        s.Data.Add New ArrayList

        Dim myCol As Long
        For myCol = LBound(ipTable, 2) To UBound(ipTable, 2)
        
            s.Data.Item(myRow).Add myCol, ipTable(myRow, myCol)
            
        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
    
        myCol.Add s.Data.Item(myRow).Item(ipCol)
    
    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