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

LVL 1

-PolakAsked: 2015-07-07

Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

Experts Exchange Solution brought to you by

Enjoy your complimentary solution view.

Get every solution instantly with Premium. Start your 7-day free trial.

I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

LVL 1

-PolakAuthor Commented: 2015-07-11

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!

LVL 1

-PolakAuthor Commented: 2015-07-11

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

LVL 1

-PolakAuthor Commented: 2015-07-11

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

LVL 27

ProfessorJimJamMicrosoft Excel ExpertCommented: 2015-07-12

@Polak,

apart from calculation set to manual and screenupdating turned off in your code.
you code add the below codes, and remember to reverse their status at the end of your macro.

it will also enhance the speed with if you use 'WITH' statement for example instead of
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

you could use with application
.screenupdating=false
.caclulcation=xcalculationmanual
.diplaystatusbar-false
etc so on

'Turn Off Status Bar Update
Application.DisplayStatusBar = False

'command Excel to Ignore Events
Application.EnableEvents = False

'Hide Page breaks and also note this is a sheet-level setting
Activesheet.DisplayPageBreaks = False

'Suspend Pivot Table Updates
ActiveSheet.PivotTables("YOURPIVOTTABLE").ManualUpdate=True

LVL 1

-PolakAuthor Commented: 2015-07-17

Hi Jim, I'll test out your code shortly, just been busy!

LVL 31

gowflowCommented: 2015-07-23

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

LVL 1

-PolakAuthor Commented: 2015-07-23

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

LVL 31

gowflowCommented: 2015-07-23

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

LVL 1

-PolakAuthor Commented: 2015-07-23

Do you have the PowerPivot COM add-in installed?

LVL 31

gowflowCommented: 2015-07-23

Nope

LVL 1

-PolakAuthor Commented: 2015-07-23

That would be why, comes with excel 2013 by default, to install:
https://support.office.com/en-CA/article/Start-the-Power-Pivot-in-Microsoft-Excel-add-in-a891a66d-36e3-43fc-81e8-fc4798f39ea8

If on 2010: http://www.microsoft.com/en-us/download/details.aspx?id=7609

LVL 31

gowflowCommented: 2015-07-23

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

LVL 1

-PolakAuthor Commented: 2015-07-23

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.

LVL 31

gowflowCommented: 2015-07-23

ok try this version

Let me know
gowflow
SyncSlicerProblem-07.xlsm

LVL 1

-PolakAuthor Commented: 2015-07-23

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?

LVL 31

gowflowCommented: 2015-07-23

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

LVL 1

-PolakAuthor Commented: 2015-07-23

Take as much time as you need, my workbook.... works, this is just icing on the cake.

LVL 31

gowflowCommented: 2015-07-23

Well I just looked up the link you posted and am afraid cannot download this file of 121MB I have Excel 2010 do not have 2013. and cannot run the code not update the pivots as they were created in Excel 2013. Am afraid I will have to pass on this one as do not know the behavior of update pivot events when you have slicers. Maybe one thing you want to try is add

.EnableEvents = False

after .ScreenUpdating = False and set it back to True on Exit or just under .ScreenUpdating = True

It may prevent going into update event recursively which could be the reason for the delay.

gowflow

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial

LVL 1

-PolakAuthor Commented: 2015-07-23

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!

LVL 1

-PolakAuthor Commented: 2015-07-24

Thanks Guys

It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today

VB Script

From novice to tech pro — start learning today.

Microsoft Applications

By:

Sandra Batakis

Certification
Certification: MOS Microsoft Office Specialist - Excel 2007 Adva…

Premium

Premium members can enroll in this course at no extra cost.
Learn More

188 lessons
Microsoft Applications

By:

Sandra Batakis

Certification
Certification: MOS Microsoft Office Specialist - Excel 2007 Basic

Premium

Premium members can enroll in this course at no extra cost.
Learn More

239 lessons
Microsoft Applications

By:

Sandra Batakis

Certification
Certification: MOS Microsoft Office Specialist - Excel 2007 Inter…

Premium

Premium members can enroll in this course at no extra cost.
Learn More

218 lessons
Microsoft Applications

By:

Debbie Fierst

Certification
Certification: MOS Microsoft Office Specialist - Excel 2010 Adva…

Premium

Premium members can enroll in this course at no extra cost.
Learn More

183 lessons
Microsoft Applications

By:

Debbie Fierst

Certification
Certification: MOS Microsoft Office Specialist - Excel 2010 Basic

Premium

Premium members can enroll in this course at no extra cost.
Learn More

264 lessons
Microsoft Applications

By:

Debbie Fierst

Certification
Certification: MOS Microsoft Office Specialist - Excel 2010 Inter…

Premium

Premium members can enroll in this course at no extra cost.
Learn More

277 lessons
Microsoft Applications

By:

Debbie Fierst

Certification
Certification: MOS Microsoft Office Specialist - Excel 2013 Part …

Premium

Premium members can enroll in this course at no extra cost.
Learn More

176 lessons
Microsoft Applications

By:

Debbie Fierst

Certification
Certification: MOS Microsoft Office Specialist - Excel 2013 Part …

Premium

Premium members can enroll in this course at no extra cost.
Learn More

146 lessons
Document Management

By:

Debbie Fierst

Certification
Certification: MOS Microsoft Office Specialist - Excel 2013 Part …

Premium

Premium members can enroll in this course at no extra cost.
Learn More

116 lessons
Microsoft Applications

By:

Patrick Loner

Certification
Certification: MOS Microsoft Office Specialist - Excel 2016 Part …

Premium

Premium members can enroll in this course at no extra cost.
Learn More

212 lessons