5
\$\begingroup\$

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

\$\endgroup\$
7
  • \$\begingroup\$ 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. \$\endgroup\$
    – Freeflow
    Jan 12, 2021 at 11:25
  • \$\begingroup\$ 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:) \$\endgroup\$
    – Greedo
    Jan 12, 2021 at 11:28
  • 1
    \$\begingroup\$ I added some details of what my plans were for this function \$\endgroup\$ Jan 12, 2021 at 16:00
  • \$\begingroup\$ 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") \$\endgroup\$
    – Greedo
    Jan 13, 2021 at 16:33
  • \$\begingroup\$ @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. \$\endgroup\$
    – TinMan
    Jan 14, 2021 at 1:14

2 Answers 2

3
\$\begingroup\$

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
\$\endgroup\$
3
  • 1
    \$\begingroup\$ 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). \$\endgroup\$ Feb 13, 2021 at 23:14
  • 1
    \$\begingroup\$ 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. \$\endgroup\$ Feb 14, 2021 at 22:44
  • \$\begingroup\$ @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. \$\endgroup\$
    – TinMan
    Feb 15, 2021 at 0:34
0
\$\begingroup\$

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
\$\endgroup\$
1
  • \$\begingroup\$ 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. \$\endgroup\$ Mar 25, 2021 at 16:21

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge that you have read and understand our privacy policy and code of conduct.

Not the answer you're looking for? Browse other questions tagged or ask your own question.