Private Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable)
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim scOLAP As SlicerCache
Dim scList As SlicerCache
Dim sO As Slicer
Dim sL As Slicer
Dim si As SlicerItem
Dim i As Integer
Dim svalue As String
Dim ar() As String
Set scOLAP = ActiveWorkbook.SlicerCaches("Slicer_RegionCode")
Set scList = ActiveWorkbook.SlicerCaches("Slicer_RegionCode2")
scList.ClearManualFilter
Set sO = scOLAP.Slicers(1)
Set sL = scList.Slicers(1)
ReDim ar(UBound(scOLAP.VisibleSlicerItemsList))
For i = 1 To UBound(scOLAP.VisibleSlicerItemsList)
svalue = Replace(Replace(scOLAP.VisibleSlicerItemsList(i), "[TablePPCleanUORC].[RegionCode].&[", ""), "]", "")
ar(i) = svalue
Next
For Each si In scList.SlicerItems
If UBound(Filter(ar, si.SourceName)) < 0 Then
si.Selected = False
End If
Next
Set scOLAP = ActiveWorkbook.SlicerCaches("Slicer_OpLocationCode")
Set scList = ActiveWorkbook.SlicerCaches("Slicer_OpLocationCode2")
scList.ClearManualFilter
Set sO = scOLAP.Slicers(1)
Set sL = scList.Slicers(1)
ReDim ar(UBound(scOLAP.VisibleSlicerItemsList))
For i = 1 To UBound(scOLAP.VisibleSlicerItemsList)
svalue = Replace(Replace(scOLAP.VisibleSlicerItemsList(i), "[TablePPCleanUORC].[RegionCode].&[", ""), "]", "")
ar(i) = svalue
Next
For Each si In scList.SlicerItems
If UBound(Filter(ar, si.SourceName)) < 0 Then
si.Selected = False
End If
Next
Set scOLAP = ActiveWorkbook.SlicerCaches("Slicer_AvailableAsset")
Set scList = ActiveWorkbook.SlicerCaches("Slicer_AvailableAsset2")
scList.ClearManualFilter
Set sO = scOLAP.Slicers(1)
Set sL = scList.Slicers(1)
ReDim ar(UBound(scOLAP.VisibleSlicerItemsList))
For i = 1 To UBound(scOLAP.VisibleSlicerItemsList)
svalue = Replace(Replace(scOLAP.VisibleSlicerItemsList(i), "[TablePPCleanUORC].[RegionCode].&[", ""), "]", "")
ar(i) = svalue
Next
For Each si In scList.SlicerItems
If UBound(Filter(ar, si.SourceName)) < 0 Then
si.Selected = False
End If
Next
Set scOLAP = ActiveWorkbook.SlicerCaches("Slicer_StratMissionSet")
Set scList = ActiveWorkbook.SlicerCaches("Slicer_StratMissionSet2")
scList.ClearManualFilter
Set sO = scOLAP.Slicers(1)
Set sL = scList.Slicers(1)
ReDim ar(UBound(scOLAP.VisibleSlicerItemsList))
For i = 1 To UBound(scOLAP.VisibleSlicerItemsList)
svalue = Replace(Replace(scOLAP.VisibleSlicerItemsList(i), "[TablePPCleanUORC].[RegionCode].&[", ""), "]", "")
ar(i) = svalue
Next
For Each si In scList.SlicerItems
If UBound(Filter(ar, si.SourceName)) < 0 Then
si.Selected = False
End If
Next
Set scOLAP = ActiveWorkbook.SlicerCaches("Slicer_TOMISTypeClean")
Set scList = ActiveWorkbook.SlicerCaches("Slicer_TOMISTypeClean2")
scList.ClearManualFilter
Set sO = scOLAP.Slicers(1)
Set sL = scList.Slicers(1)
ReDim ar(UBound(scOLAP.VisibleSlicerItemsList))
For i = 1 To UBound(scOLAP.VisibleSlicerItemsList)
svalue = Replace(Replace(scOLAP.VisibleSlicerItemsList(i), "[TablePPCleanUORC].[RegionCode].&[", ""), "]", "")
ar(i) = svalue
Next
For Each si In scList.SlicerItems
If UBound(Filter(ar, si.SourceName)) < 0 Then
si.Selected = False
End If
Next
Set scOLAP = ActiveWorkbook.SlicerCaches("Slicer_AssetSuitability")
Set scList = ActiveWorkbook.SlicerCaches("Slicer_AssetSuitability2")
scList.ClearManualFilter
Set sO = scOLAP.Slicers(1)
Set sL = scList.Slicers(1)
ReDim ar(UBound(scOLAP.VisibleSlicerItemsList))
For i = 1 To UBound(scOLAP.VisibleSlicerItemsList)
svalue = Replace(Replace(scOLAP.VisibleSlicerItemsList(i), "[TablePPCleanUORC].[RegionCode].&[", ""), "]", "")
ar(i) = svalue
Next
For Each si In scList.SlicerItems
If UBound(Filter(ar, si.SourceName)) < 0 Then
si.Selected = False
End If
Next
Set scOLAP = ActiveWorkbook.SlicerCaches("Slicer_PastPerformance")
Set scList = ActiveWorkbook.SlicerCaches("Slicer_PastPerformance2")
scList.ClearManualFilter
Set sO = scOLAP.Slicers(1)
Set sL = scList.Slicers(1)
ReDim ar(UBound(scOLAP.VisibleSlicerItemsList))
For i = 1 To UBound(scOLAP.VisibleSlicerItemsList)
svalue = Replace(Replace(scOLAP.VisibleSlicerItemsList(i), "[TablePPCleanUORC].[RegionCode].&[", ""), "]", "")
ar(i) = svalue
Next
For Each si In scList.SlicerItems
If UBound(Filter(ar, si.SourceName)) < 0 Then
si.Selected = False
End If
Next
Set scOLAP = ActiveWorkbook.SlicerCaches("Slicer_Authorization")
Set scList = ActiveWorkbook.SlicerCaches("Slicer_Authorization2")
scList.ClearManualFilter
Set sO = scOLAP.Slicers(1)
Set sL = scList.Slicers(1)
ReDim ar(UBound(scOLAP.VisibleSlicerItemsList))
For i = 1 To UBound(scOLAP.VisibleSlicerItemsList)
svalue = Replace(Replace(scOLAP.VisibleSlicerItemsList(i), "[TablePPCleanUORC].[RegionCode].&[", ""), "]", "")
ar(i) = svalue
Next
For Each si In scList.SlicerItems
If UBound(Filter(ar, si.SourceName)) < 0 Then
si.Selected = False
End If
Next
Set scOLAP = ActiveWorkbook.SlicerCaches("Slicer_Priority")
Set scList = ActiveWorkbook.SlicerCaches("Slicer_Priority2")
scList.ClearManualFilter
Set sO = scOLAP.Slicers(1)
Set sL = scList.Slicers(1)
ReDim ar(UBound(scOLAP.VisibleSlicerItemsList))
For i = 1 To UBound(scOLAP.VisibleSlicerItemsList)
svalue = Replace(Replace(scOLAP.VisibleSlicerItemsList(i), "[TablePPCleanUORC].[RegionCode].&[", ""), "]", "")
ar(i) = svalue
Next
For Each si In scList.SlicerItems
If UBound(Filter(ar, si.SourceName)) < 0 Then
si.Selected = False
End If
Next
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
Reset Slicers on Active Worksheet Code:
Public Sub ResetSlicers(ws As Worksheet)
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim sc As SlicerCache
Dim scs As SlicerCaches
Dim slice As Slicer
Set scs = ws.Parent.SlicerCaches
If Not scs Is Nothing Then
For Each sc In scs
For Each slice In sc.Slicers
If slice.Shape.Parent Is ws Then
sc.ClearManualFilter
Exit For 'unnecessary to check the other slicers of the slicer cache
End If
Next slice
Next sc
End If
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
Experts Exchange always has the answer, or at the least points me in the correct direction! It is like having another employee that is extremely experienced.
When asked, what has been your best career decision?
Deciding to stick with EE.
Being involved with EE helped me to grow personally and professionally.
Connect with Certified Experts to gain insight and support on specific technology challenges including:
We've partnered with two important charities to provide clean water and computer science education to those who need it most. READ MORE