AboutPricingCommunityTeamsStart Free TrialLog in
Avatar of -Polak
-Polak
Flag for United States of America asked on

Anyway to Speed Up this Code?

Hi Experts,
I'm doing the following in my workbook.
1. Using OLAP Slicers to Filter data that resides in PowerPivot. Less than 500 records worth of data.
2. Passing the Selections in these OLAP-Slicers back to some Non-OLAP-Slicers (via the code below) which enables me to "ShowDetails" if using multiple filtering criteria. The Non-OLAP-Slicer are connected to a regular Pivot Table that summarizes a Regular Excel Table. FYI Having the Non-OLAP Slicers connect to a Pivoted Summary of the Excel Table ran faster than having the OLAP slicer selections passed directly to slicers connected to the Excel Table.
3. It takes about 3-5 seconds to pass any selection made in the OLAP Slicers to the Non-OLAP slicers (I am "okay" with this)
4. I'm using the 2nd bit of code below to reset all of the OLAP SlicerCaches on the their respective worksheet; this obviously triggers the Pivot table change event and as a consequence takes around 21-25seconds to run.

I'd like to improve the performance of 4, and if possible 3. Thus far, I've tried to create Calculated Fields in PowerPivot and put those into the PivotTable(s) that are being refreshed when the PivotChange event occurs (as opposed to, having the PivotTable itself calculate Sums, Averages, etc...) This has helped some. Is there anything else I can do?

OLAP to Non-OLAP Slicer Sync Code: 
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

Open in new window

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

Open in new window

VB ScriptVisual Basic ClassicMicrosoft Excel
Avatar of undefined
Last Comment
-Polak
8/22/2022 - Mon
-Polak
ASKER
Oh wow, I just noticed I made a epicly stupid error copying and pasting each instance of the slicer Sync code and not changing the column name in the svalue replace statement. One moment while I go clean that up and see if it works better!
-Polak
ASKER
Darn, No; that didn't work; however, given that the code still worked both ways I KNOW there has to be a better way to write this.
Corrected SlicerSync Code:
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

Open in new window

-Polak
ASKER
I've accomplished writing the code using a custom function to check selected vs. non-selected slicer items; to my chagrin the code isn't any faster tho. Pasted below for those more familiar with VBA than me to see if they can improve upon it:

Custom Function: 
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

Open in new window

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

Open in new window

All of life is about relationships, and EE has made a viirtual community a real community. It lifts everyone's boat
William Peck
SOLUTION
Professor J
THIS SOLUTION ONLY AVAILABLE TO MEMBERS.
View this solution by signing up for a free trial.
Members can start a 7-Day free trial and enjoy unlimited access to the platform.
See Pricing Options
Start Free Trial
GET A PERSONALIZED SOLUTION
Ask your own question & get feedback from real experts
Find out why thousands trust the EE community with their toughest problems.
-Polak
ASKER
Hi Jim, I'll test out your code shortly, just been busy!
gowflow
I just saw the help needed for this question. Did you get your solution ? Is what proposed helped ? if not then could you please attach a workbook containing the code and NOT just code posted in several threads like you did as all this will only complicate things and take much longer to process.

Rgds/gowflow
-Polak
ASKER
Goflow, sorry I don't remember doing that with this particular question, but I'm sorry if I did. Here are two sample workbooks, one uses the original code and one uses the custom function to achieve the syncing of OLAP slicers to Non-OLAP slicers.

Regarding Jim's code, no after doing some testing disabling events and setting the pivot table to manual update did not speed up the resetting of all slicers.

I've attached two workbooks,
One with the original code and one with the custom functions to see if y'all can improve. However, you're not going to see the same 40sec processing time that I'm seeing during reset in my real workbook because the data in PowerPivot is fake/dummy. However, perhaps you'll be able to spot something.

I think I might have a clue for you, in the real workbook there are 9 slicers. ScreenUpdating is false at the start of the code, therefore I should only see the various pivot charts and tables the slicers connect to updated once at the completion of the code. However that is not the case, I see the screen update by the number of slicers that do not have "all" slicer items selected minus 1. For example, if 4 slicers have selections made in them, I will see the screen update 3 times before the reset is complete.

That leads me to believe the code is looping, which at first I thought was tied to the Worksheet_PivotTableUpdate(ByVal Target As PivotTable) event. However, JimJam's
ActiveSheet.PivotTables("YOURPIVOTTABLE").ManualUpdate=True code did not stop the looping behavior. So I'm not entirely sure what's going on.

Anyway here are the files...
SyncSlicerProblem-07.11.2015-StarainCode
SyncSlicerProblem-07.11-2015-ErikCustomF
⚡ FREE TRIAL OFFER
Try out a week of full access for free.
Find out why thousands trust the EE community with their toughest problems.
gowflow
I am not able to get your workbook to work I get an error Database not available when I click on a slicer. So cannot verify the code

gowflow
-Polak
ASKER
Do you have the PowerPivot COM add-in installed?
gowflow
Nope
I started with Experts Exchange in 2004 and it's been a mainstay of my professional computing life since. It helped me launch a career as a programmer / Oracle data analyst
William Peck
-Polak
ASKER
gowflow
mmmm you want me to install an add-in ?

Well let me see your problem before I go on a venture.

Your problem is that when you activate the button Reset Slicers you find the code too slow right ?

or it is something else ??
gowflow
-Polak
ASKER
Yes, the syncing of OLAP silcers (connected to PowerPivot data) to my Non-OLAP slicers (connected to a regular excel table that duplicates the PowerPivot data)  is too slow when all 9 slicers are reset at the same time. When just syncing after a selection is made in 1 of the 9 slicers the code runs fairly quickly 3-4 seconds to sync.

To me there appears to be a loop occurring because of the Screen Updating behavior I mentioned earlier.
⚡ FREE TRIAL OFFER
Try out a week of full access for free.
Find out why thousands trust the EE community with their toughest problems.
gowflow
ok try this version

Let me know
gowflow
SyncSlicerProblem-07.xlsm
-Polak
ASKER
Hi gowflow, no not right off the bat, but I played with it a little bit. If I place the calculation and screenupdating code as you did in the reset macro and comment out the calc and screenupdating code in the pivottable change event then the behavior I describe above stops (no more updates to the pivot charts & tables while the reset code is running)

However, downside to this is when I run JUST the code under the pivottable change event, ala when selecting items from the 9 slicers and I'm not interested in resetting them. What was 3-4 seconds before is now 13-14secs.

Is there anyway to "step through" code that is triggered by an event, to get a better idea of whats happening?
gowflow
I think I will need to install the add-in if you are patient with me then I will test this tomorrow if no one beats me to it as it is here now 1AM

gowflow
Experts Exchange is like having an extremely knowledgeable team sitting and waiting for your call. Couldn't do my job half as well as I do without it!
James Murphy
-Polak
ASKER
Take as much time as you need, my workbook.... works, this is just icing on the cake.
ASKER CERTIFIED SOLUTION
gowflow
THIS SOLUTION ONLY AVAILABLE TO MEMBERS.
View this solution by signing up for a free trial.
Members can start a 7-Day free trial and enjoy unlimited access to the platform.
See Pricing Options
Start Free Trial
⚡ FREE TRIAL OFFER
Try out a week of full access for free.
Find out why thousands trust the EE community with their toughest problems.
-Polak
ASKER
Disregard my previous comment if you read it... yes, disabling events would indeed speed up the reset code; however, after all of the OLAP slicers were reset there would be nothing that triggered the syncing of that reset back to the non-OLAP slicers. Ergo, the non-OLAP slicers would reflect the last selection of the OLAP slicers before the reset.

But the idea is correct, perhaps the best approach if the goal is to speed up the Reset code is in addition to disabling Events telling the reset macro to .ClearManualFilters on all of the non-OLAP slicers. This way they would be by in "sync" with the OLAP slicers with out actually using the Pivot Table change event code to sync them...?

EDIT: disregard the above, I forgot that my sample-workbook-reset-code reset all slicers in the active workbook. In my real workbook I was only clearing the slicers on the active worksheet. Disabling Events will work if i reset all slicers in the active workbook, thank you!
-Polak
ASKER
Thanks Guys
⚡ FREE TRIAL OFFER
Try out a week of full access for free.
Find out why thousands trust the EE community with their toughest problems.
Plans and Pricing
Resources
Product
Podcasts
Careers
Contact Us
Teams
Certified Expert Program
Credly Partnership
Udemy Partnership
Privacy Policy
Terms of Use

© 1996-2023 Experts Exchange, LLC. All rights reserved. Covered by US Patent