Optimize Excel Pivot Table Filter Using Array VBA

Question

I have a userform in which a user will check all items they want a group of pivot tables filtered on. The issue is I have about 40 pivot tables and over 250 options the user can filter on. Ideally, I planned to set the pivot table filter to an array of values, but I cannot find a solution that avoids looping through the array and filter options. Please find my code below. Any optimization advice is greatly appreciated. Thank you!

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

What's wrong with looping? Or, why are you trying to optimize this code? I suspect the real issue is the 40 pivot tables with 250 options. — Byron Wall
– Byron Wall, Commented Jul 15, 2015 at 15:44
Hi Bryon, yes I agree the issue is the quantity. This code works quickly when both the number of pivot tables and the number of options is limited. Though it may not be possible, I was wondering if there is a way to set the filter of each pivot table with one line like you can do with a column. — Alexis
– Alexis, Commented Jul 15, 2015 at 19:14
It can be done if the fields are given as OLAP using the PivotField.VisibleItemsList. Not sure if it is faster. If you want to try that, use the Data Model option on the Pivot Tables. I suspect that might require a conversion of all the tables. — Byron Wall
– Byron Wall, Commented Jul 15, 2015 at 19:50

Alexis · Accepted Answer · 2015-07-16 15:23:42Z

I ended up filtering the original set of data based on my array and copying and pasting those filtered values to a new table on a different sheet. This new sheet became the source data for my 40 pivot tables. This change created several smaller issues, but now the code runs in <10 seconds compared to 90 seconds. Thank you to everyone that provided suggestions to this issue.

Private Sub Filter_btn_Click()
Dim i As Integer
Dim n As Integer
Dim MyArray() As String

Application.ScreenUpdating = False

Set dashboard = Sheets("Dashboard")
Set Org_data = Sheets("Original Data")
Set Filtered_Data = Sheets("Filtered Data")

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

Filtered_Data.Activate
ActiveSheet.ListObjects("Table2").DataBodyRange.Select
Selection.ClearContents

'Copy values filtered on array
Org_data.Activate
Org_data.ShowAllData
With Org_data.Range("A1")
    .AutoFilter Field:=2, Criteria1:=MyArray, Operator:=xlFilterValues
End With
ActiveSheet.ListObjects("Table1").DataBodyRange.Select
Selection.Copy

'Paste filtered values
Filtered_Data.Activate
ActiveSheet.ListObjects("Table2").DataBodyRange.Select
Selection.PasteSpecial xlPasteValues

Application.CutCopyMode = False

'Refresh all pivot tables at once
ActiveWorkbook.RefreshAll
dashboard.Activate

Application.ScreenUpdating = True

Unload Me

End Sub

Collectives™ on Stack Overflow

Optimize Excel Pivot Table Filter Using Array VBA

1 Answer 1

Comments

Your Answer

Linked

Hot Network Questions

Collectives™ on Stack Overflow

1 Answer 1

Comments

Your Answer

Sign up or log in

Post as a guest

Linked

Related