VBA runs slow. How can I speed this up.

GaryHinton

New Member
Joined
Jun 13, 2016
Messages
18
Office Version
  1. 365
Platform
  1. Windows
Sub ap()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
Dim Sh As Worksheet
Dim pvt As PivotTable
Dim nm As String

For Each Sh In Sheets
Sh.Unprotect "ABC"
Next

For Each Sh In Sheets
For Each pvt In Sh.PivotTables
nm = Sh.Name
pvt.PivotCache.Refresh
Next
Next

For Each Sh In Sheets
Sh.Protect "ABC", _
DrawingObjects:=False, _
Contents:=True, _
Scenarios:=False, _
AllowSorting:=True, _
AllowFiltering:=True, _
AllowFormattingCells:=True, _
AllowUsingPivotTables:=True
Sh.EnableSelection = xlUnlockedCells
For Each Sheet In Sheets
Sheet.Activate
ActiveWindow.DisplayGridlines = False
Next Sheet
Next
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True

End Sub
 

Excel Facts

What do {} around a formula in the formula bar mean?
{Formula} means the formula was entered using Ctrl+Shift+Enter signifying an old-style array formula.
You're looping through the sheets three or four different times. I'm sure that has something to do with it. How about this:

VBA Code:
Sub ap()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
Dim Sh As Worksheet
Dim pvt As PivotTable
Dim nm As String

For Each Sh In Sheets
     Sh.Unprotect "ABC"
     For Each pvt In Sh.PivotTables
          nm = Sh.Name
          pvt.PivotCache.Refresh
     Next
     Sh.Protect "ABC", _
     DrawingObjects:=False, _
     Contents:=True, _
     Scenarios:=False, _
     AllowSorting:=True, _
     AllowFiltering:=True, _
     AllowFormattingCells:=True, _
     AllowUsingPivotTables:=True
     Sh.EnableSelection = xlUnlockedCells
     Sheet.Activate
     ActiveWindow.DisplayGridlines = False
Next

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True

End Sub
 
Upvote 0
Maybe:
VBA Code:
Sub ap()
    With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
        .EnableEvents = False
    End With
    Dim Sh As Worksheet, pvt As PivotTable, nm As String
    For Each Sh In Sheets
        With Sh
            .Activate
            .Unprotect "ABC"
            For Each pvt In .PivotTables
                nm = .Name
                pvt.PivotCache.Refresh
            Next pvt
            .Protect "ABC", DrawingObjects:=False, Contents:=True, Scenarios:=False, AllowSorting:=True, _
                AllowFiltering:=True, AllowFormattingCells:=True, AllowUsingPivotTables:=True
            ActiveWindow.DisplayGridlines = False
        End With
    Next Sh
    With Application
        .ScreenUpdating = True
        .Calculation = xlCalculationAutomatic
        .EnableEvents = True
    End With
End Sub
 
Upvote 0
What do you mean by slow? Sometimes it is good to add code to help you understand where the slow parts are.

Example:
VBA Code:
Sub ap()
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False
   
    Dim Sh As Worksheet
    Dim SavedSh As Worksheet
    Dim pvt As PivotTable
    'Dim nm As String
   
    Dim ST As Single, OST As Single, ET1 As Single, ET2 As Single, ET3 As Single, ET4 As Single
    OST = Timer
   
    Set SavedSh = ActiveSheet 'save current sheet
   
    For Each Sh In Sheets
        ST = Timer
        'Unlock
        Sh.Unprotect "ABC"
        ET1 = ET1 + Timer - ST
        ST = Timer
       
        'Do stuff
        For Each pvt In Sh.PivotTables
            'nm = Sh.Name
            pvt.PivotCache.Refresh
        Next pvt
        ET2 = ET2 + Timer - ST
        ST = Timer
       
        Sh.Activate
        ActiveWindow.DisplayGridlines = False
        ET3 = ET3 + Timer - ST
        ST = Timer
       
        'Relock
        Sh.Protect "ABC", _
        DrawingObjects:=False, _
        Contents:=True, _
        Scenarios:=False, _
        AllowSorting:=True, _
        AllowFiltering:=True, _
        AllowFormattingCells:=True, _
        AllowUsingPivotTables:=True
        Sh.EnableSelection = xlUnlockedCells
        ET4 = ET4 + Timer - ST
    Next Sh
   
    'Profiling data
    Debug.Print vbCrLf & "Execution Data @" & Format(Time, "hh:mm:ss") & ":"
    Debug.Print "Elapsed Time to unprotect worksheet: " & ET1
    Debug.Print "Elapsed Time to refresh pivot table caches: " & ET2
    Debug.Print "Elapsed Time to turn off gridlines: " & ET3
    Debug.Print "Elapsed Time to relock sheet: " & ET4
    Debug.Print "Overall Elapsed Time: " & Timer - OST
   
    SavedSh.Activate 'restore current sheet
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
End Sub
 
Upvote 0
Currently none of the 3 options given will even run my excel. I will see if I can upload the sheet for review
 
Upvote 0
Currently none of the 3 options given will even run my excel
That's odd because none of those 3 modify your posted code in any major way. If your code runs, they should run.
 
Upvote 0
I suggest that you update your Account details (or click your user name at the top right of the forum) so helpers always know what Excel version(s) & platform(s) you are using as the best solution often varies by version. (Don’t forget to scroll down & ‘Save’)

Also, MrExcel has a tool called “XL2BB” that lets you post samples of your data that will allow us to copy/paste it to our Excel spreadsheets, so we can work with the same copy of data that you are. Instructions on using this tool can be found here: XL2BB Add-in

Note that there is also a "Test Here” forum on this board. This is a place where you can test using this tool (or any other posting techniques that you want to test) before trying to use those tools in your actual posts.
 
Upvote 0
That's odd because none of those 3 modify your posted code in any major way. If your code runs, they should run.
I don't actually agree with this. All 3 modified options only unprotect 1 sheet at a time.
If the pivot on that sheet shares the Cache with a pivot on another still protected sheet you will get the error message.
"That command cannot be performed while a protected sheet contains another PivotTable report based on the same source data."
Currently none of the 3 options given will even run my excel. I will see if I can upload the sheet for review
What does this even mean ? Are you getting an error message and is it the error message above ?
If not what is it ? When you click on debug what line is highlighted ?
 
Upvote 0
I don't actually agree with this. All 3 modified options only unprotect 1 sheet at a time.

I suppose that it true. Is it normal for pivot tables on multiple sheets to share the same cache? I don't work with them much. Still, if the OP runs the version I posted, he should at least get some execution data to narrow down what is causing the routine to be slow. My operating philosophy on speeding up execution is that you first have to know what parts are slowing it down. pvt.PivotCache.Refresh seems like the likely suspect, but as an old mentor used to tell me, "to measure is to know".
 
Upvote 0
1694896832710.png

This is what I get with RlVo1 code
 
Upvote 0

Forum statistics

Threads
1,215,219
Messages
6,123,687
Members
449,117
Latest member
Aaagu

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top