Autofilter method with a dynamically created array not filtering-CodePudding

I've created a dynamic array from an Excel table using the following code.

For Each rCell In rngVisible
    ReDim Preserve myArray(0 To i)
    myArray(i) = rCell
    i = i   1
    Debug.Print myArray(i - 1)
Next rCell

This is how I'm instantiating this myArray variable.

Dim myArray() As Variant

From debug printing I know the array contains the items I need; however, when use in the AutoFilter method, it doesn't filter properly another table I have in the same sheet. After reading various posts, it was recommended that I transpose my array, which you can see below as Application.Transpose(myArray), but it's not working. I've even made my array start at the 0 index. But the following line fails to properly filter my table

EventsTable.Range.AutoFilter Field:=1, Criteria1:=Application.Transpose(myArray), Operator:=xlFilterValues

Below is how that table looks (there's nothing in there apparently). But all the filters are still selected. Such a weird result/behavior. Can someone please share some thoughts as to why this might be happening? Thanks in advance

Below you can see the entire macro

Sub ApplyFilterToTable()
Dim nonretired As Variant
Dim myArray() As Variant
Dim i As Variant
Dim SystemsTable, EventsTable As ListObject
Dim rngData, rngVisible As Range

' Defining and Filtering SystemsTable
Set SystemsTable = Worksheets("AllSystems_Filtered").ListObjects("SystemsTable15")
nonretired = VBA.Array("Ready for Use", "Service Due", "Out of Service", "Pending Log Entry")
SystemsTable.Range.AutoFilter Field:=11, Criteria1:=nonretired, Operator:=xlFilterValues

' Prework for filter matching 'Events' table based on Systems Table
LastRow = SystemsTable.Range.Rows.Count
Set rngData = Worksheets("AllSystems_Filtered").Range("F1:F" & LastRow)

'Set the visible range
With rngData
    Set rngVisible = .Offset(1, 0).Resize(.Rows.Count - 1, 1).SpecialCells(xlCellTypeVisible)
End With

' Now loop through the visible range to get the actual values
For Each rCell In rngVisible
    ReDim Preserve myArray(0 To i)
    myArray(i) = rCell
    i = i   1
    Debug.Print myArray(i - 1)
Next rCell

' Convert
right_array = VBA.Array(myArray)

' Defining and Filtering corresponding 'Events' table
Set EventsTable = Worksheets("AllSystems_Filtered").ListObjects("EventsTable16")
EventsTable.Range.AutoFilter Field:=1, Criteria1:=Application.Transpose(myArray), Operator:=xlFilterValues

End Sub

CodePudding user response：

This worked for me (one table above the other):

Sub ApplyFilterToTable()
    Dim nonretired As Variant
    Dim myArray() As Variant
    Dim i As Long, wsSystems As Worksheet
    Dim SystemsTable As ListObject, EventsTable As ListObject
    Dim rngVisible As Range, rCell As Range, dict As Object
    
    Set dict = CreateObject("scripting.dictionary")
    Set wsSystems = ThisWorkbook.Worksheets("AllSystems_Filtered")
    
    nonretired = VBA.Array("Ready for Use", "Service Due", "Out of Service", "Pending Log Entry")
    
    ' Defining and Filtering SystemsTable
    Set SystemsTable = wsSystems.ListObjects("SystemsTable15")
    UnFilter SystemsTable     'clear any previous filters
    SystemsTable.Range.AutoFilter Field:=11, Criteria1:=nonretired, Operator:=xlFilterValues
    
    'all visible cells in col#6 (or use the header name)
    On Error Resume Next  'ignore error if no visible rows
    Set rngVisible = SystemsTable.ListColumns(6).DataBodyRange.SpecialCells(xlCellTypeVisible)
    On Error GoTo 0
    
    If Not rngVisible Is Nothing Then
        
        For Each rCell In rngVisible
            dict(CStr(rCell.Value)) = True 'collect unique values as keys in dictionary
        Next rCell

        Set EventsTable = wsSystems.ListObjects("EventsTable16")
        UnFilter EventsTable       'clear any previous filters
        EventsTable.Range.AutoFilter Field:=1, Criteria1:=dict.keys, Operator:=xlFilterValues

    End If
End Sub

Sub UnFilter(lo As ListObject)
    On Error Resume Next
    lo.AutoFilter.ShowAllData
End Sub