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
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_RegionCode1")
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_OpLocationCode1")
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].[OpLocationCode].&[", ""), "]", "")
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_AvailableAsset1")
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].[AvailableAsset].&[", ""), "]", "")
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_StratMissionSet1")
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].[StratMissionSet].&[", ""), "]", "")
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_TOMISTypeClean1")
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].[TOMISTypeClean].&[", ""), "]", "")
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_AssetSuitability1")
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].[AssetSuitability].&[", ""), "]", "")
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_NewRequirement")
Set scList = ActiveWorkbook.SlicerCaches("Slicer_NewRequirement1")
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].[NewRequirement].&[", ""), "]", "")
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_Authorization1")
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].[Authorization].&[", ""), "]", "")
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_Priority1")
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].[Priority].&[", ""), "]", "")
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
Function CheckSelectedSI(testFor As String, sc As SlicerCache)
Dim k As Integer
For k = 1 To UBound(sc.VisibleSlicerItemsList)
If testFor = Replace(Replace(sc.VisibleSlicerItemsList(k), "[TablePPCleanUORC].[RegionCode].&[", ""), "]", "") Then
CheckSelectedSI = True
Exit For
End If
Next
For k = 1 To UBound(sc.VisibleSlicerItemsList)
If testFor = Replace(Replace(sc.VisibleSlicerItemsList(k), "[TablePPCleanUORC].[OpLocationCode].&[", ""), "]", "") Then
CheckSelectedSI = True
Exit For
End If
Next
For k = 1 To UBound(sc.VisibleSlicerItemsList)
If testFor = Replace(Replace(sc.VisibleSlicerItemsList(k), "[TablePPCleanUORC].[AvailableAsset].&[", ""), "]", "") Then
CheckSelectedSI = True
Exit For
End If
Next
For k = 1 To UBound(sc.VisibleSlicerItemsList)
If testFor = Replace(Replace(sc.VisibleSlicerItemsList(k), "[TablePPCleanUORC].[StratMissionSet].&[", ""), "]", "") Then
CheckSelectedSI = True
Exit For
End If
Next
For k = 1 To UBound(sc.VisibleSlicerItemsList)
If testFor = Replace(Replace(sc.VisibleSlicerItemsList(k), "[TablePPCleanUORC].[TOMISTypeClean].&[", ""), "]", "") Then
CheckSelectedSI = True
Exit For
End If
Next
For k = 1 To UBound(sc.VisibleSlicerItemsList)
If testFor = Replace(Replace(sc.VisibleSlicerItemsList(k), "[TablePPCleanUORC].[AssetSuitability].&[", ""), "]", "") Then
CheckSelectedSI = True
Exit For
End If
Next
For k = 1 To UBound(sc.VisibleSlicerItemsList)
If testFor = Replace(Replace(sc.VisibleSlicerItemsList(k), "[TablePPCleanUORC].[NewRequirement].&[", ""), "]", "") Then
CheckSelectedSI = True
Exit For
End If
Next
For k = 1 To UBound(sc.VisibleSlicerItemsList)
If testFor = Replace(Replace(sc.VisibleSlicerItemsList(k), "[TablePPCleanUORC].[Authorization].&[", ""), "]", "") Then
CheckSelectedSI = True
Exit For
End If
Next
For k = 1 To UBound(sc.VisibleSlicerItemsList)
If testFor = Replace(Replace(sc.VisibleSlicerItemsList(k), "[TablePPCleanUORC].[Priority].&[", ""), "]", "") Then
CheckSelectedSI = True
Exit For
End If
Next
End Function
PivotChange event
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 j As Integer
Dim l As Integer
Dim svalue As String
Set scOLAP = ActiveWorkbook.SlicerCaches("Slicer_RegionCode")
Set scList = ActiveWorkbook.SlicerCaches("Slicer_RegionCode1")
scList.ClearManualFilter
Set sO = scOLAP.Slicers(1)
Set sL = scList.Slicers(1)
For j = 1 To scList.SlicerItems.Count
scList.SlicerItems(j).Selected = CheckSelectedSI(scList.SlicerItems(j).SourceName, scOLAP)
Next
Set scOLAP = ActiveWorkbook.SlicerCaches("Slicer_OpLocationCode")
Set scList = ActiveWorkbook.SlicerCaches("Slicer_OpLocationCode1")
scList.ClearManualFilter
Set sO = scOLAP.Slicers(1)
Set sL = scList.Slicers(1)
For l = 1 To scList.SlicerItems.Count
scList.SlicerItems(l).Selected = CheckSelectedSI(scList.SlicerItems(l).SourceName, scOLAP)
Next
Set scOLAP = ActiveWorkbook.SlicerCaches("Slicer_AvailableAsset")
Set scList = ActiveWorkbook.SlicerCaches("Slicer_AvailableAsset1")
scList.ClearManualFilter
Set sO = scOLAP.Slicers(1)
Set sL = scList.Slicers(1)
For l = 1 To scList.SlicerItems.Count
scList.SlicerItems(l).Selected = CheckSelectedSI(scList.SlicerItems(l).SourceName, scOLAP)
Next
Set scOLAP = ActiveWorkbook.SlicerCaches("Slicer_StratMissionSet")
Set scList = ActiveWorkbook.SlicerCaches("Slicer_StratMissionSet1")
scList.ClearManualFilter
Set sO = scOLAP.Slicers(1)
Set sL = scList.Slicers(1)
For l = 1 To scList.SlicerItems.Count
scList.SlicerItems(l).Selected = CheckSelectedSI(scList.SlicerItems(l).SourceName, scOLAP)
Next
Set scOLAP = ActiveWorkbook.SlicerCaches("Slicer_TOMISTypeClean")
Set scList = ActiveWorkbook.SlicerCaches("Slicer_TOMISTypeClean1")
scList.ClearManualFilter
Set sO = scOLAP.Slicers(1)
Set sL = scList.Slicers(1)
For l = 1 To scList.SlicerItems.Count
scList.SlicerItems(l).Selected = CheckSelectedSI(scList.SlicerItems(l).SourceName, scOLAP)
Next
Set scOLAP = ActiveWorkbook.SlicerCaches("Slicer_AssetSuitability")
Set scList = ActiveWorkbook.SlicerCaches("Slicer_AssetSuitability1")
scList.ClearManualFilter
Set sO = scOLAP.Slicers(1)
Set sL = scList.Slicers(1)
For l = 1 To scList.SlicerItems.Count
scList.SlicerItems(l).Selected = CheckSelectedSI(scList.SlicerItems(l).SourceName, scOLAP)
Next
Set scOLAP = ActiveWorkbook.SlicerCaches("Slicer_NewRequirement")
Set scList = ActiveWorkbook.SlicerCaches("Slicer_NewRequirement1")
scList.ClearManualFilter
Set sO = scOLAP.Slicers(1)
Set sL = scList.Slicers(1)
For l = 1 To scList.SlicerItems.Count
scList.SlicerItems(l).Selected = CheckSelectedSI(scList.SlicerItems(l).SourceName, scOLAP)
Next
Set scOLAP = ActiveWorkbook.SlicerCaches("Slicer_Authorization")
Set scList = ActiveWorkbook.SlicerCaches("Slicer_Authorization1")
scList.ClearManualFilter
Set sO = scOLAP.Slicers(1)
Set sL = scList.Slicers(1)
For l = 1 To scList.SlicerItems.Count
scList.SlicerItems(l).Selected = CheckSelectedSI(scList.SlicerItems(l).SourceName, scOLAP)
Next
Set scOLAP = ActiveWorkbook.SlicerCaches("Slicer_Priority")
Set scList = ActiveWorkbook.SlicerCaches("Slicer_Priority1")
scList.ClearManualFilter
Set sO = scOLAP.Slicers(1)
Set sL = scList.Slicers(1)
For l = 1 To scList.SlicerItems.Count
scList.SlicerItems(l).Selected = CheckSelectedSI(scList.SlicerItems(l).SourceName, scOLAP)
Next
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub