Search code examples
vbaexcelslicers

How to speed up this VBA code with slicers?


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

Solution

  • 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