How to speed up this VBA code with slicers?

Question

I have a spreadsheet with seven tables (tbl_1, tbl_2 ...tbl_7) each controlled by its own slicer. Each slicer has six buttons (10, 20, 30, 40, 50, 60) referring to Team Codes. I use the code below to select one team on every slicer, then create a PDF for each team / slicer setting. As of now, the code takes anywhere from 5-7min to run. Any help is much appreciated.

Sub SlicerTeam()
Dim wb As Workbook
Dim sc As SlicerCache
Dim si As SlicerItem

On Error GoTo errHandler
Application.ScreenUpdating = False
Application.EnableEvents = False

Set wb = ThisWorkbook

For x = 1 To 6
    For i = 1 To 7
    Set sc = wb.SlicerCaches("tbl_" & i)
        sc.ClearAllFilters
        For Each si In sc.VisibleSlicerItems
            Set si = sc.SlicerItems(si.Name)
                If Not si Is Nothing Then
                    If si.Name = x * 10 Then
                        si.Selected = True
                    Else
                        si.Selected = False
                    End If
                Else
                    si.Selected = False
                End If
        Next si

    Next i
Call PDFCreate
Next x

exitHandler:
Application.ScreenUpdating = True
Application.EnableEvents = True
Exit Sub

errHandler:
MsgBox ("Error in updating slicer filters.")
Resume exitHandler

End Sub

Answer 1

After several trials.. found this is the best option.

1. Disable calculations:

   Application.ScreenUpdating = False
   With Application
   .EnableEvents = False
   .Calculation = xlCalculationManual
   End With
   

2. type code to Remove slicer conections.... example:

   ActiveWorkbook.SlicerCaches("Slicer_Area").PivotTables.RemovePivotTable ( _
       ActiveSheet.PivotTables("PivotDatosGraficoAbsoluto"))
   

3. Set slicer value to true, and others to false... example:

   Set MySlicerCache = ActiveWorkbook.SlicerCaches("Slicer_Area")
               For i = 1 To MySlicerCache.SlicerItems.Count
                   With MySlicerCache.SlicerItems(i)
                       If .Name = "Comercial GJ" Then
                           .Selected = True
                           'Range("E1").Value = .Name
                       Else:
                           .Selected = False
                       End If
                   End With
               Next i
   

4. Do the Slicer conections.. example:

   ActiveWorkbook.SlicerCaches("Slicer_Area").PivotTables.AddPivotTable ( _
        ActiveSheet.PivotTables("PivotDatosGraficoAbsoluto"))
   

5. Enable Events:

   With Application
   
     .EnableEvents = True
   
     .Calculation = xlCalculationAutomatic
   

   End With

This will save aprox 40% of waiting time

Answer 2

Assuming that these slicers are slicing pivot tables, try the below code. It may help speed things up, depending on how big your PivotTables are.

Sub SlicerTeam()
Dim wb As Workbook
Dim sc As SlicerCache
Dim si As SlicerItem

dim pt as PivotTable

On Error GoTo errHandler
Application.ScreenUpdating = False
Application.EnableEvents = False

Set wb = ThisWorkbook

For Each pt in wb.PivotTables
    pt.ManualUpdate = True
Next

For x = 1 To 6
    For i = 1 To 7
    Set sc = wb.SlicerCaches("tbl_" & i)
        sc.ClearAllFilters
        For Each si In sc.VisibleSlicerItems
            Set si = sc.SlicerItems(si.Name)
                If Not si Is Nothing Then
                    If si.Name = x * 10 Then
                        si.Selected = True
                    Else
                        si.Selected = False
                    End If
                Else
                    si.Selected = False
                End If
        Next si

    Next i

    For Each pt in wb.PivotTables
        pt.ManualUpdate = True
    Next


    Call PDFCreate
Next x

exitHandler:
Application.ScreenUpdating = True
Application.EnableEvents = True
Exit Sub

errHandler:
MsgBox ("Error in updating slicer filters.")
Resume exitHandler

End Sub