CODEWITHSUNDEEP
excelvbapivot-tableslicers
bigsim
bigsim

Reputation: 140

Speeding up add/remove PivotTable to Slicer VBA

I have a workbook that has a number of Pivot Tables spread across a number of worksheets. There's a bunch of slicers on one of the worksheets, and they're pretty slow-ish to load after changing filters/selections.

All of my slicers are on the same worksheet (call it Sheet1), but only 4 out of 15 pivot tables are on that worksheet. I'd like to remove the remaining 11 Pivot Tables that aren't in that same worksheet from the slicers when Sheet1 is activated, and add them back again when it's deactivated to attempt to improve performance. I've written some code to do this, but it's prohibitively slow at the moment - it takes about a minute to run (when I select/deselect the worksheet), but the slicer speedup is only 1 second instead of 6 seconds. Is there any way to speed up what I've got? TIA!

Private Sub Worksheet_Deactivate()

    Application.Calculation = xlManual
    Application.ScreenUpdating = False
    pts = Array( _
        Worksheets("Sheet1").PivotTables("Pivot1"), _
        Worksheets("Sheet1").PivotTables("Pivot2"), _
        Worksheets("Sheet1").PivotTables("Pivot3"), _
        Worksheets("Sheet1").PivotTables("Pivot4"), _
        Worksheets("Sheet2").PivotTables("Pivot5"), _
        Worksheets("Sheet2").PivotTables("Pivot6"), _
        Worksheets("Sheet3").PivotTables("Pivot7"), _
        Worksheets("Sheet4").PivotTables("Pivot8"), _
        Worksheets("Sheet5").PivotTables("Pivot9"), _
        Worksheets("Sheet6").PivotTables("Pivot10"), _
        Worksheets("Sheet7").PivotTables("Pivot11"), _
        Worksheets("Sheet7").PivotTables("Pivot12"), _
        Worksheets("Sheet7").PivotTables("Pivot13"), _
        Worksheets("Sheet7").PivotTables("Pivot14"), _
        Worksheets("Sheet7").PivotTables("Pivot15") _
    )
    ss = Array( _
        ActiveWorkbook.SlicerCaches("Slicer1"), _
        ActiveWorkbook.SlicerCaches("Slicer2"), _
        ActiveWorkbook.SlicerCaches("Slicer3"), _
        ActiveWorkbook.SlicerCaches("Slicer4") _
    )
    For Each pt In pts
        For Each s In ss
            s.PivotTables.RemovePivotTable (pt)
        Next s
    Next pt
        Application.Calculation = xlAutomatic
        Application.ScreenUpdating = True
        
End Sub

Upvotes: 3

Views: 236

Answers (1)

RicardinhoL
RicardinhoL

Reputation: 207

try this modification and check if it is what you need.

Private Sub Worksheet_Deactivate()

    Application.Calculation = xlManual
    Application.ScreenUpdating = False
    
    Dim ws As Worksheet
    Dim pt As PivotTable
    Dim sc As SlicerCache
    
    ' Store the worksheet names and pivot table names in an array
    Dim wsNames As Variant
    wsNames = Array("Sheet1", "Sheet2", "Sheet3", "Sheet4", "Sheet5", "Sheet6", "Sheet7", "Sheet7", "Sheet7", "Sheet7", "Sheet7", "Sheet7")
    
    Dim ptNames As Variant
    ptNames = Array("Pivot1", "Pivot2", "Pivot3", "Pivot4", "Pivot5", "Pivot6", "Pivot7", "Pivot8", "Pivot9", "Pivot10", "Pivot11", "Pivot12", "Pivot13", "Pivot14", "Pivot15")
    
    ' Loop through each worksheet and pivot table
    For i = LBound(wsNames) To UBound(wsNames)
        Set ws = ThisWorkbook.Worksheets(wsNames(i))
        Set pt = ws.PivotTables(ptNames(i))
        
        ' Loop through each slicer cache and remove the pivot table
        For Each sc In ThisWorkbook.SlicerCaches
            sc.PivotTables.RemovePivotTable pt
        Next sc
    Next i
    
    Application.Calculation = xlAutomatic
    Application.ScreenUpdating = True

End Sub

Upvotes: 0

Related Questions