Tengo un formulario de usuario en el que un usuario verificará todos los elementos en los que desea que se filtre un grupo de tablas dinámicas. El problema es que tengo alrededor de 40 tablas dinámicas y más de 250 opciones que el usuario puede filtrar. Idealmente, planeé establecer el filtro de la tabla dinámica en una matriz de valores, pero no puedo encontrar una solución que evite recorrer las opciones de matriz y filtro. Por favor encuentre mi código a continuación. Cualquier consejo de optimización es muy apreciado. ¡Gracias!

Private Sub Filter_btn_Click()
Dim i As Integer
Dim n As Integer
Dim filter_num As Integer
Dim pivot_num As Integer
Dim MyArray() As String
Dim pt As PivotTable

Application.ScreenUpdating = False

Set dashboard = Sheets("Dashboard")

'Adding all selected items to array
n = 0
For i = 0 To Supplier_Listbox.ListCount - 1
    If Supplier_Listbox.Selected(i) = True Then
        ReDim Preserve MyArray(n)
        MyArray(n) = Supplier_Listbox.List(i)
        n = n + 1
    End If
Next

i = 0
For pivot_num = 1 To 41
    Set pt = dashboard.PivotTables("PivotTable" & pivot_num)
    filter_num = 0
    With pt.PivotFields("FilterItems")
        'Include first item in filter to avoid error
        .PivotItems(1).Visible = True
        ' PivotItems.Count is 270
        For i = 2 To .PivotItems.Count
            ' Attempted to make the code a little faster with first if statement. Will avoid function if all array items have been checked
            If filter_num = n Then
            .PivotItems(i).Visible = False
           ' Call to function
           ElseIf IsInArray(.PivotItems(i), MyArray) Then
                .PivotItems(i).Visible = True
                filter_num = filter_num + 1
            Else:
                .PivotItems(i).Visible = False
            End If
        Next
       'Check if first item is actually in array, if not, remove filter
       If IsInArray(.PivotItems(1), MyArray) Then
                .PivotItems(1).Visible = True
            Else:
                .PivotItems(1).Visible = False
            End If
    End With
Next

Unload Me

Application.ScreenUpdating = True

End Sub