3
\$\begingroup\$

Using a technique described in this StackOverflow answer by @David Murdoch I created a custom class with methods to speed up Excel (Activate turns off screen updates and set the calculation mode to manual) and to restore it to normal settings (Shutdown). When the object reaches the end of its life and Class_Terminate is triggered it runs the Shutdown procedure.

The purpose of all this is to avoid problems that occur if (when) I forget to reset these settings at the end of a script or if my code (contains a bug that) skips the section resetting these settings.

I am looking for a broad critique of the nit-picky variety. In other words, how you would code this.

This code intentionally ignores the initial state of the settings and always turns on screen updating and sets the calculation mode to automatic when the object is destroyed.

The following is in a class module called ExcelTurboBooster.

Option Explicit
'
' Use the code below to turn off screen updates and automatic
' calculations. Screen updates and automatic calculations will be
' restored when the calling procedure terminates.
'
' EXAMPLE USAGE
' ======================================================================
' Dim objExcelTurboBooster As New ExcelTurboBooster
' objExcelTurboBooster.Activate ' Activates booster
' objExcelTurboBooster.Shutdown ' Use to deactivate before procedure
' ' terminates
' ======================================================================
'
'
Public Sub Activate()
 Application.Calculation = xlCalculationManual
 Application.ScreenUpdating = False
End Sub
Public Sub Shutdown()
 On Error Resume Next
 Application.Calculation = xlCalculationAutomatic
 Application.ScreenUpdating = True
End Sub
Private Sub Class_Terminate()
 Shutdown
End Sub
asked Dec 8, 2017 at 2:07
\$\endgroup\$

3 Answers 3

4
\$\begingroup\$

I think you have a potential usage issue with wrapping these methods in a class. While it's convenient that the Class_Terminate method will automatically re-enable updating, it makes keeping track of the usage of such an object the responsibility of the caller (or calling module or of the entire project). Where you can easily get into trouble is when you start making calls to other objects or functions that might need to make the same disable/enable actions for speed. This is especially apparent if you create a personal library of routines that you can reuse.

My preferred approach to this was to create a standalone module that I can easily import into any VBA project and use immediately. The public methods are DisableUpdating and EnableUpdating. In every day use I can now create:

Sub MainProgram()
 DisableUpdating
 ...
 LibrarySub1 <some vars>
 ...
 EnableUpdating
End Sub
Sub LibrarySub1(<some vars>)
 DisableUpdating
 ...
 EnableUpdating
End Sub

But you can see the potential problem in nesting these calls.

My solution in the standalone module is:

Option Explicit
Private updateNestCount As Long
Private calculationState As XlCalculation
Public Sub DisableUpdating(Optional msg As String = vbNullString)
 If updateNestCount = 0 Then
 Application.ScreenUpdating = False
 '--- save the current calculation state for later restoration
 calculationState = Application.Calculation
 Application.Calculation = xlCalculationManual
 End If
 updateNestCount = updateNestCount + 1
 '--- print a debug message if the caller wants one
 If Len(msg) > 0 Then
 Debug.Print "DisableUpdating(" & updateNestCount & "): " & msg
 End If
End Sub
Public Sub EnableUpdating(Optional msg As String = vbNullString)
 If updateNestCount = 1 Then
 Application.ScreenUpdating = False
 '--- restore the calculation back to its original state
 Application.Calculation = calculationState
 End If
 updateNestCount = updateNestCount - 1
 '--- print a debug message if the caller wants one
 If Len(msg) > 0 Then
 Debug.Print "EnableUpdating (" & updateNestCount & "): " & msg
 End If
End Sub

Now I can liberally sprinkle these Disable/Enable calls in my libraries and other routines and the private variable takes care counting how deeply nested it might be. I've run into the need to track some debug on occasion, so the optional msg comes in handy.

I think your class/object approach leaves too much of the burden on the calling program to keep track of the object lifetime and you might find this a simpler approach. Just make sure to always pair the calls in a single routine AND if you have an error handler, that the enable method is accessed within the error handling.

UPDATE: In response to a comment below, I'm posting my updated code module in its entirety (which includes a bonus high-performance timer, just for fun). Copy and paste this code into a file outside of the VBA Editor, then import it into your code and you'll get Intellisense to help with the functions.

Attribute VB_Name = "Lib_PerformanceSupport"
Attribute VB_Description = "Methods to control disabling/enabling of the Application level screen updates. Supports call nesting and debug messaging, plus high precision timer calls."
'@Folder("Libraries")
Option Explicit
'------------------------------------------------------------------------------
' For Update methods
'
Private Type SavedState
 screenUpdate As Boolean
 calculationType As XlCalculation
 eventsFlag As Boolean
 callCounter As Long
End Type
Private previousState As SavedState
Private Const DEBUG_MODE As Boolean = False 'COMPILE TIME ONLY!!
'------------------------------------------------------------------------------
' For Precision Counter methods
'
Private Type LargeInteger
 lowpart As Long
 highpart As Long
End Type
#If VBA7 Then
 Private Declare PtrSafe Function QueryPerformanceCounter Lib _
 "kernel32" (ByRef lpPerformanceCount As LargeInteger) As Long
 Private Declare PtrSafe Function QueryPerformanceFrequency Lib _
 "kernel32" (ByRef lpFrequency As LargeInteger) As Long
#Else
 Private Declare Function QueryPerformanceCounter Lib _
 "kernel32" (ByRef lpPerformanceCount As LargeInteger) As Long
 Private Declare Function QueryPerformanceFrequency Lib _
 "kernel32" (ByRef lpFrequency As LargeInteger) As Long
#End If
Private counterStart As LargeInteger
Private crFrequency As Double
Private Const TWO_32 As Double = 4294967296# ' = 256# * 256# * 256# * 256#
'==============================================================================
' Screen and Event Update Controls
'
Public Sub ReportUpdateState()
Attribute ReportUpdateState.VB_Description = "Prints to the immediate window the current state and values of the Application update controls."
 Debug.Print ":::::::::::::::::::::::::::::::::::::::::::::::::::::"
 Debug.Print "Application.ScreenUpdating = " & Application.ScreenUpdating
 Debug.Print "Application.Calculation = " & Application.Calculation
 Debug.Print "Application.EnableEvents = " & Application.EnableEvents
 Debug.Print "--previousState.screenUpdate = " & previousState.screenUpdate
 Debug.Print "--previousState.calculationType = " & previousState.calculationType
 Debug.Print "--previousState.eventsFlag = " & previousState.eventsFlag
 Debug.Print "--previousState.callCounter = " & previousState.callCounter
 Debug.Print "--DEBUG_MODE is currently " & DEBUG_MODE
End Sub
Public Sub DisableUpdates(Optional ByVal debugMsg As String = vbNullString, _
 Optional ByVal forceZero As Boolean = False)
Attribute DisableUpdates.VB_Description = "Disables Application level updates and events and saves their initial state to be restored later. Supports nested calls. Displays debug messages according to the module-global DEBUG_MODE flag."
 With Application
 '--- capture previous state if this is the first time
 If forceZero Or (previousState.callCounter = 0) Then
 previousState.screenUpdate = .ScreenUpdating
 previousState.calculationType = .Calculation
 previousState.eventsFlag = .EnableEvents
 previousState.callCounter = 0
 End If
 '--- now turn it all off and count
 .ScreenUpdating = False
 .Calculation = xlCalculationManual
 .EnableEvents = False
 previousState.callCounter = previousState.callCounter + 1
 '--- optional stuff
 If DEBUG_MODE Then
 Debug.Print "Updates disabled (" & previousState.callCounter & ")";
 If Len(debugMsg) > 0 Then
 Debug.Print debugMsg
 Else
 Debug.Print vbCrLf
 End If
 End If
 End With
End Sub
Public Sub EnableUpdates(Optional ByVal debugMsg As String = vbNullString, _
 Optional ByVal forceZero As Boolean = False)
Attribute EnableUpdates.VB_Description = "Restores Application level updates and events to their state, prior to the *first* DisableUpdates call. Supports nested calls. Displays debug messages according to the module-global DEBUG_MODE flag."
 With Application
 '--- countdown!
 If previousState.callCounter >= 1 Then
 previousState.callCounter = previousState.callCounter - 1
 ElseIf forceZero = False Then
 '--- shouldn't get here
 Debug.Print "EnableUpdates ERROR: reached callCounter = 0"
 End If
 '--- only re-enable updates if the counter gets to zero
 ' or we're forcing it
 If forceZero Or (previousState.callCounter = 0) Then
 .ScreenUpdating = True
 .Calculation = xlCalculationAutomatic
 .EnableEvents = True
 End If
 '--- optional stuff
 If DEBUG_MODE Then
 Debug.Print "Updates enabled (" & previousState.callCounter & ")";
 If Len(debugMsg) > 0 Then
 Debug.Print debugMsg
 Else
 Debug.Print vbCrLf
 End If
 End If
 End With
End Sub
'==============================================================================
' Precision Timer Controls
' based on https://stackoverflow.com/a/31387007/4717755
'
Private Function LI2Double(ByRef lgInt As LargeInteger) As Double
Attribute LI2Double.VB_Description = "Converts LARGE_INTEGER to Double"
 '--- converts LARGE_INTEGER to Double
 Dim low As Double
 low = lgInt.lowpart
 If low < 0 Then
 low = low + TWO_32
 End If
 LI2Double = lgInt.highpart * TWO_32 + low
End Function
Public Sub StartCounter()
Attribute StartCounter.VB_Description = "Captures the high precision counter value to use as a starting reference time."
 '--- Captures the high precision counter value to use as a starting
 ' reference time.
 Dim perfFrequency As LargeInteger
 QueryPerformanceFrequency perfFrequency
 crFrequency = LI2Double(perfFrequency)
 QueryPerformanceCounter counterStart
End Sub
Public Function TimeElapsed() As Double
Attribute TimeElapsed.VB_Description = "Returns the time elapsed since the call to StartCounter in microseconds."
 '--- Returns the time elapsed since the call to StartCounter in microseconds
 If crFrequency = 0# Then
 Err.Raise Number:=11, _
 Description:="Must call 'StartCounter' in order to avoid " & _
 "divide by zero errors."
 End If
 Dim crStart As Double
 Dim crStop As Double
 Static counterEnd As LargeInteger
 QueryPerformanceCounter counterEnd
 crStart = LI2Double(counterStart)
 crStop = LI2Double(counterEnd)
 TimeElapsed = 1000# * (crStop - crStart) / crFrequency
End Function
answered Dec 8, 2017 at 17:06
\$\endgroup\$
5
  • \$\begingroup\$ I like your approach! It can avoid unnecessary enabling and disabling of features. That's particularly useful when a full workbook recalculation takes a long time since setting the calculation mode to automatic triggers a recalculation. \$\endgroup\$ Commented Apr 2, 2018 at 21:47
  • 1
    \$\begingroup\$ old post, but thought to bring it to notice of @PeterT. I have nested the above calls into multiple procedures which are called in sequence (one after another to generate different reports). If one of the loops in a particular nested procedure has a shape.copy & paste statement to copy multiple images via looping, which occasionally results in a shape copy paste timing error, the enableUpdating of the Top procedure is called instead of the current nested procedure. This results in the code and workbook going haywire. Any ideas why this is happening? \$\endgroup\$ Commented Mar 6, 2020 at 18:20
  • \$\begingroup\$ This is only observed where a Shape copy paste is involved, where the errorhandler makes the jump to the Main or Topmost procedure instead of executing the nested one. \$\endgroup\$ Commented Mar 6, 2020 at 18:20
  • \$\begingroup\$ How can this be avoided? \$\endgroup\$ Commented Mar 6, 2020 at 18:20
  • \$\begingroup\$ One feature I've added to my own EnableUpdating sub is the ForceZero parameter. Adding this parameter to the top level allows that final call to zero out the updateNestCount and forcibly enable ScreenUpdating and Calculation. If one of the lower level methods generates an error that skips all the other EnableUpdating, then you can make sure everything is taken care of at the top. I've updated my post above to show the current version of the module I'm using. \$\endgroup\$ Commented Mar 6, 2020 at 19:00
3
\$\begingroup\$

I would point out that the naming convention is inconsistent -- we have Activate and a Shutdown --- they don't say the same thing to me. I'd expect corresponding actions to have names like Activate -> Deactivate, Enable -> Disable, Startup -> Shutdown. Given the nature of the class, Enable/Disable pair seems the best suited for what your class is going to do, since it's basically toggling an application level state.

Your Shutdown has an On Error Resume Next but says nothing if it was successful. I would at least expect the procedure to exit with something like ShutDown = (Err.Number = 0) so that the calling client can at least know there was a clean exit or not. However, I'm more inclined to encourage to rethink whether you really want a Resume Next there, because you are dealing with altering the application's state, so it is crucial to know that the alterations were successful so that the clients can proceed with the assumption that they are in the correct state.

The other thing that occurs to me is that you probably don't actually need the methods at all. You only need the Class_Initialize and Class_Terminate. Your calling code then becomes...

Set booster = New ExcelTurboBooster
'Do lot of complicated stuff....
Set booster = Nothing 

Look, ma, no methods! In fact, technically you only need the first line. The last line is superficial because when your procedure that instantiate the object exits (even if it exited badly), the instance will go poof and the application state should be reset. The biggest downside of that method, though, is that error handling becomes somehow strange inside the Initialize/Terminate events, so it could be difficult to communicate to your clients there has been a problem.

The downside with the no-method approach is that it totally can't go into a public field of any standard module or maybe long-lived classes either because then they will persist too much longer. One'd have to take discipline to use it only as a local variable inside procedure so that it will be destroyed at the end of the procedure. Otherwise, you've built up a new layer of complication for nothing.

answered Dec 8, 2017 at 4:06
\$\endgroup\$
2
\$\begingroup\$

It's dangerous to not save the state of Application.Calculation and Application.ScreenUpdating.

Also, what's the purpose of the On Error Resume Next? There's no way for those two calls to fail, and the error handling gets turned back on when Shutdown exits.

answered Dec 8, 2017 at 2:43
\$\endgroup\$

Your Answer

Draft saved
Draft discarded

Sign up or log in

Sign up using Google
Sign up using Email and Password

Post as a guest

Required, but never shown

Post as a guest

Required, but never shown

By clicking "Post Your Answer", you agree to our terms of service and acknowledge you have read our privacy policy.

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.