I was able to Frankenstein a VBA code listed on the contextures website to function with two sets of slicers, but now the sheet is slow to react. I think the issue is becuase I have everything in one macro and don't know how to split them and have them work correctly. I don't know enough about VBA to fix the slow running issue and don't know if or how I can get two separate macros to run correctly. Below is the original code and my Frankenstein code. Please help me make the sheet run faster.
Original from Contextures w/ my slicer names:
Private Sub Worksheet_PivotTableUpdate _
(ByVal Target As PivotTable)
Dim wb As Workbook
Dim scShort As SlicerCache
Dim scLong As SlicerCache
Dim siShort As SlicerItem
Dim siLong As SlicerItem
On Error GoTo errHandler
Application.ScreenUpdating = False
Application.EnableEvents = False
Set wb = ThisWorkbook
Set scShort = wb.SlicerCaches("Slice_Work_center1")
Set scLong = wb.SlicerCaches("Slicer_Work_center")
scLong.ClearManualFilter
For Each siLong In scLong.VisibleSlicerItems
Set siLong = scLong.SlicerItems(siLong.Name)
Set siShort = Nothing
On Error Resume Next
Set siShort = scShort.SlicerItems(siLong.Name)
On Error GoTo errHandler
If Not siShort Is Nothing Then
If siShort.Selected = True Then
siLong.Selected = True
ElseIf siShort.Selected = False Then
siLong.Selected = False
End If
Else
siLong.Selected = False
End If
Next siLong
exitHandler:
Application.ScreenUpdating = True
Application.EnableEvents = True
Exit Sub
errHandler:
MsgBox "Could not update pivot table"
Resume exitHandler
End Sub
Mine w/ two sets of slices that is slow:
rivate Sub Worksheet_PivotTableUpdate _
(ByVal Target As PivotTable)
Dim wb As Workbook
Dim scShort As SlicerCache
Dim scLong As SlicerCache
Dim siShort As SlicerItem
Dim siLong As SlicerItem
Dim scShorta As SlicerCache
Dim scLonga As SlicerCache
Dim siShorta As SlicerItem
Dim siLonga As SlicerItem
On Error GoTo errHandler
Application.ScreenUpdating = False
Application.EnableEvents = False
Set wb = ThisWorkbook
Set scShort = wb.SlicerCaches("Slicer_Work_center1")
Set scLong = wb.SlicerCaches("Slicer_Work_center")
scLong.ClearManualFilter
For Each siLong In scLong.VisibleSlicerItems
Set siLong = scLong.SlicerItems(siLong.Name)
Set siShort = Nothing
On Error Resume Next
Set siShort = scShort.SlicerItems(siLong.Name)
On Error GoTo errHandler
If Not siShort Is Nothing Then
If siShort.Selected = True Then
siLong.Selected = True
ElseIf siShort.Selected = False Then
siLong.Selected = False
End If
Else
siLong.Selected = False
End If
Next siLong
On Error GoTo errHandler
Application.ScreenUpdating = False
Application.EnableEvents = False
Set scShorta = wb.SlicerCaches("Slicer_Week_Count1")
Set scLonga = wb.SlicerCaches("Slicer_Week_Count")
scLonga.ClearManualFilter
For Each siLonga In scLonga.VisibleSlicerItems
Set siLonga = scLonga.SlicerItems(siLonga.Name)
Set siShorta = Nothing
On Error Resume Next
Set siShorta = scShorta.SlicerItems(siLonga.Name)
On Error GoTo errHandler
If Not siShorta Is Nothing Then
If siShorta.Selected = True Then
siLonga.Selected = True
ElseIf siShorta.Selected = False Then
siLonga.Selected = False
End If
Else
siLonga.Selected = False
End If
Next siLonga
exitHandler:
Application.ScreenUpdating = True
Application.EnableEvents = True
Exit Sub
errHandler:
MsgBox "Could not update pivot table"
Resume exitHandler
End Sub
Original from Contextures w/ my slicer names:
Private Sub Worksheet_PivotTableUpdate _
(ByVal Target As PivotTable)
Dim wb As Workbook
Dim scShort As SlicerCache
Dim scLong As SlicerCache
Dim siShort As SlicerItem
Dim siLong As SlicerItem
On Error GoTo errHandler
Application.ScreenUpdating = False
Application.EnableEvents = False
Set wb = ThisWorkbook
Set scShort = wb.SlicerCaches("Slice_Work_center1")
Set scLong = wb.SlicerCaches("Slicer_Work_center")
scLong.ClearManualFilter
For Each siLong In scLong.VisibleSlicerItems
Set siLong = scLong.SlicerItems(siLong.Name)
Set siShort = Nothing
On Error Resume Next
Set siShort = scShort.SlicerItems(siLong.Name)
On Error GoTo errHandler
If Not siShort Is Nothing Then
If siShort.Selected = True Then
siLong.Selected = True
ElseIf siShort.Selected = False Then
siLong.Selected = False
End If
Else
siLong.Selected = False
End If
Next siLong
exitHandler:
Application.ScreenUpdating = True
Application.EnableEvents = True
Exit Sub
errHandler:
MsgBox "Could not update pivot table"
Resume exitHandler
End Sub
Mine w/ two sets of slices that is slow:
rivate Sub Worksheet_PivotTableUpdate _
(ByVal Target As PivotTable)
Dim wb As Workbook
Dim scShort As SlicerCache
Dim scLong As SlicerCache
Dim siShort As SlicerItem
Dim siLong As SlicerItem
Dim scShorta As SlicerCache
Dim scLonga As SlicerCache
Dim siShorta As SlicerItem
Dim siLonga As SlicerItem
On Error GoTo errHandler
Application.ScreenUpdating = False
Application.EnableEvents = False
Set wb = ThisWorkbook
Set scShort = wb.SlicerCaches("Slicer_Work_center1")
Set scLong = wb.SlicerCaches("Slicer_Work_center")
scLong.ClearManualFilter
For Each siLong In scLong.VisibleSlicerItems
Set siLong = scLong.SlicerItems(siLong.Name)
Set siShort = Nothing
On Error Resume Next
Set siShort = scShort.SlicerItems(siLong.Name)
On Error GoTo errHandler
If Not siShort Is Nothing Then
If siShort.Selected = True Then
siLong.Selected = True
ElseIf siShort.Selected = False Then
siLong.Selected = False
End If
Else
siLong.Selected = False
End If
Next siLong
On Error GoTo errHandler
Application.ScreenUpdating = False
Application.EnableEvents = False
Set scShorta = wb.SlicerCaches("Slicer_Week_Count1")
Set scLonga = wb.SlicerCaches("Slicer_Week_Count")
scLonga.ClearManualFilter
For Each siLonga In scLonga.VisibleSlicerItems
Set siLonga = scLonga.SlicerItems(siLonga.Name)
Set siShorta = Nothing
On Error Resume Next
Set siShorta = scShorta.SlicerItems(siLonga.Name)
On Error GoTo errHandler
If Not siShorta Is Nothing Then
If siShorta.Selected = True Then
siLonga.Selected = True
ElseIf siShorta.Selected = False Then
siLonga.Selected = False
End If
Else
siLonga.Selected = False
End If
Next siLonga
exitHandler:
Application.ScreenUpdating = True
Application.EnableEvents = True
Exit Sub
errHandler:
MsgBox "Could not update pivot table"
Resume exitHandler
End Sub