How to speed up this VBA code with slicers? - vba

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

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

Answer 2

After several trials.. found this is the best option.
Disable calculations:
Application.ScreenUpdating = False
With Application
.EnableEvents = False
.Calculation = xlCalculationManual
End With
type code to Remove slicer conections.... example:
ActiveWorkbook.SlicerCaches("Slicer_Area").PivotTables.RemovePivotTable ( _
ActiveSheet.PivotTables("PivotDatosGraficoAbsoluto"))
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
Do the Slicer conections.. example:
ActiveWorkbook.SlicerCaches("Slicer_Area").PivotTables.AddPivotTable ( _
ActiveSheet.PivotTables("PivotDatosGraficoAbsoluto"))
Enable Events:
With Application
.EnableEvents = True
.Calculation = xlCalculationAutomatic
End With
This will save aprox 40% of waiting time