VBA - Need help optimize code that's updating pivot tables.

[Cubist]

Hi,

I have a toggle on onan Excel sheet that toggles between 2 options: "Plan YTD" or "Rolling 12". The Slicer and the pivot tables would update based on the selection between the 2. It working but not at an optimal speed. I'm wondering if there's a way to speed this up. Thanks.

Sub Plan_Rolling()
   Application.ScreenUpdating = False
   Application.EnableEvents = False
 
    On Error Resume Next
 
       Dim pt As PivotTable
       Dim pivotTableOrder As Variant
       Dim pivotTableName As String
       Dim i As Long

   If Details.Range("PlanRollingSwitch") = "Plan YTD" Then 'make it R12
       Details.Range("PlanRollingSwitch") = "*Rolling 12"
        Details.Shapes("Rolling12Slicer").Visible = msoTrue

       pivotTableOrder = Array("Pivot_All_Budget", "Pivot_All_Contribs", _
                           "Pivot_Medical_Budget", "Pivot_Medical_Contribs", "Pivot_Medical_Claims", _
                           "Pivot_Medical_ASL", "Pivot_Medical_Fixed", "Pivot_Medical_Enroll", _
                           "Pivot_Dental_Budget", "Pivot_Dental_Enroll", _
                           "Pivot_Vision_Budget", "Pivot_Vision_Enroll")

       For i = LBound(pivotTableOrder) To UBound(pivotTableOrder)
           pivotTableName = pivotTableOrder(i)
           Set pt = Details.PivotTables(pivotTableName)
           With pt
               .PivotFields("Plan Year").Orientation = xlHidden
               .PivotFields("Rolling 12").Orientation = xlRowField
               .PivotFields("Rolling 12").Position = 1
               .PivotFields("Rolling 12").AutoSort xlDescending, "Rolling 12"
               .PivotFields("Month").AutoSort xlAscending, "Month"
           End With
           'Clean up
           Set pt = Nothing
           pivotTableName = vbNullString
       Next i
   Else
       Details.Range("PlanRollingSwitch") = "Plan YTD"
        pivotTableOrder = Array("Pivot_All_Budget", "Pivot_All_Contribs", _
                           "Pivot_Medical_Budget", "Pivot_Medical_Contribs", "Pivot_Medical_Claims", _
                           "Pivot_Medical_ASL", "Pivot_Medical_Fixed", "Pivot_Medical_Enroll", _
                           "Pivot_Dental_Budget", "Pivot_Dental_Enroll", _
                           "Pivot_Vision_Budget", "Pivot_Vision_Enroll")

       For i = LBound(pivotTableOrder) To UBound(pivotTableOrder)
           pivotTableName = pivotTableOrder(i)
           Set pt = Details.PivotTables(pivotTableName)
           With pt
               .PivotFields("Rolling 12").Orientation = xlHidden
               .PivotFields("Plan Year").Orientation = xlRowField
               .PivotFields("Plan Year").Position = 1
               .PivotFields("Plan Year").AutoSort xlAscending, "Plan Year"
               .PivotFields("Month").AutoSort xlAscending, "Month"
           End With
           'Clean up
           Set pt = Nothing
           pivotTableName = vbNullString
       Next i
 
    End If


   On Error GoTo 0
 
'ErrorHandlerExit:
 
 
    Application.EnableEvents = True
   Application.ScreenUpdating = True
 
End Sub

 

[Cubist]

This runs at 1 secs compared to 12 secs before.

Sub Plan_Rolling()

   Application.ScreenUpdating = False
   Application.Calculation = xlCalculationManual

   Dim pt As PivotTable
   Dim pf As PivotField
   Dim sfield As String
   Dim slicer1 As String, slicer2 As String
   Dim pivotTableOrder() As Variant
   Dim Table As Variant
   Dim Details As Worksheet
   Dim toggleShape As Shape
   Dim t As Double: t = Timer

   Set Details = ThisWorkbook.Worksheets("Details")
   pivotTableOrder = Array("Pivot_All_Budget", "Pivot_All_Contribs", _
                           "Pivot_Medical_Budget", "Pivot_Medical_Contribs", "Pivot_Medical_Claims", _
                           "Pivot_Medical_ASL", "Pivot_Medical_Fixed", "Pivot_Medical_Enroll", _
                           "Pivot_Dental_Budget", "Pivot_Dental_Enroll", _
                           "Pivot_Vision_Budget", "Pivot_Vision_Enroll")
   With ActiveSheet.Shapes(Application.Caller).TextFrame.Characters
       sfield = .Text
   End With

   For Each Table In pivotTableOrder
       Set pt = ActiveSheet.PivotTables(Table)
       With pt
           For Each pf In .RowFields
               If pf.name <> "Values" Then pf.Orientation = xlHidden
           Next pf
           .PivotFields(sfield).Orientation = xlRowField
           .PivotFields("Month").Orientation = xlRowField
           .PivotFields("Month").AutoSort xlAscending, "Month"
       End With
   Next Table

   ' Set slicer
   If sfield = "Plan Year" Then
       slicer1 = "PlanYearSlicer"
       slicer2 = "Rolling12Slicer"
   Else
       slicer1 = "Rolling12Slicer"
       slicer2 = "PlanYearSlicer"
   End If

   ' Show/hide slicers and update toggle shapes
   With Details.Shapes(slicer1)
       .Visible = msoTrue
   End With
   Set toggleShape = Details.Shapes("Rolling12Toggle")
   With toggleShape
       .Fill.ForeColor.ObjectThemeColor = msoThemeColorAccent3
       .Fill.ForeColor.Brightness = 0
   End With
   With Details.Shapes(slicer2)
       .Visible = msoFalse
   End With
   Set toggleShape = Details.Shapes("PlanYearToggle")
   With toggleShape
       .Fill.ForeColor.ObjectThemeColor = msoThemeColorAccent4
       .Fill.ForeColor.Brightness = -0.5
   End With
 
    Application.ScreenUpdating = True
   Application.Calculation = xlCalculationAutomatic
   MsgBox "Run time: " & Timer - t & " seconds."
End Sub