Managing Excel Application State /w Multiple Subroutines

Question

Conflicts arise in Excel VBA while running multiple Subroutines that modify the Application State. What happens is that the first Subroutine will turn off setting to speed up the code and then call a second Subroutine that does the same. The second Subroutine will then switch the setting back on before exiting. The original Subroutine then resumes in an incorrect Application State.

My solution uses a Static Scripting Dictionary to save and later restore the Application setting. The first call stores an array of the old setting in the Dictionary by a Key and applies the new settings. The second call uses the Key to look up the old settings and restore the Application State to its original setting before first call.

As a bonus it also print the execution time of the subroutines to the Immediate Window.

Public Sub AppState(Key As String, Optional CalcMode As XlCalculation, Optional ScreenUpdating As Boolean, Optional EnableEvents As Boolean)
 Const TIME = 0, CALC = 1, UPDATING = 2, EVENTS = 3
 Static settings As Object
 With Application
 If settings Is Nothing Then Set settings = CreateObject("Scripting.Dictionary")
 If settings.Exists(Key) Then
 Debug.Print Key; " Execution Time: "; Format((Timer - settings(Key)(TIME)) / 86400, "hh:mm:ss")
 Debug.Print String(20, "-")
 .Calculation = settings(Key)(CALC)
 .ScreenUpdating = settings(Key)(UPDATING)
 .EnableEvents = settings(Key)(EVENTS)
 settings.Remove Key
 Else
 settings.Add Key, Array(CDbl(Timer), .Calculation, .ScreenUpdating, .EnableEvents)
 .Calculation = CalcMode
 .ScreenUpdating = ScreenUpdating
 .EnableEvents = EnableEvents
 End If
 End With
End Sub

Demonstration Code

This crude example prints the Application Sate to the Immediate Window as it is modified by multiple subroutines.

Sub Main()
 ResetEvents
 PrintAppState "Original Settings: "
 AppState "Main1", xlCalculationManual, False, False
 PrintAppState "Main1 Settings"
 Test1
 Test2
 AppState "Main1"
 PrintAppState "After Main Settings Removed: "
End Sub
Sub Test1()
 Application.Wait (Now + TimeValue("0:00:02"))
End Sub
Sub Test2()
 PrintAppState "Test2 Start: "
 AppState "Test2", xlCalculationAutomatic, True, False
 PrintAppState "Test2 Settings: "
 Application.Wait (Now + TimeValue("0:00:02"))
 AppState "Test2"
 PrintAppState "After Test2 Settings Removed: "
End Sub
Sub PrintAppState(Msg As String)
 With Application
 Debug.Print Msg
 Debug.Print "ScreenUpdating: "; .ScreenUpdating
 Debug.Print "Calculation: "; .Calculation
 Debug.Print "EnableEvents: "; .EnableEvents
 Debug.Print String(20, "-")
 End With
End Sub

Immediate Window Output

Notice that the Application State is restored to it's previous setting after the same Key is used for a second time.

Original Settings: 
ScreenUpdating: True
Calculation: -4105 
EnableEvents: True
--------------------
Main1 Settings
ScreenUpdating: False
Calculation: -4135 
EnableEvents: False
--------------------
Test2 Start: 
ScreenUpdating: False
Calculation: -4135 
EnableEvents: False
--------------------
Test2 Settings: 
ScreenUpdating: True
Calculation: -4105 
EnableEvents: False
--------------------
Test2 Execution Time: 00:00:02
--------------------
After Test2 Settings Removed: 
ScreenUpdating: False
Calculation: -4135 
EnableEvents: False
--------------------
Main1 Execution Time: 00:00:04
--------------------
After Main Settings Removed: 
ScreenUpdating: True
Calculation: -4105 
EnableEvents: True
--------------------

The timer was based off off: VBA Code To Calculate How Long Your Macro Takes To Run

As always, I welcome any suggestions and/or feedback.

Addendum

I refactored my code reading @this post and @jasoninvegas comments.

'---------------------------------------------------------------------------------------
' Procedure : SaveAppState
' Author : Thomas Inzina
' Date : 12/29/2017
' Purpose1 : To Save and Restore Excel's Application State one or more times
' Purpose2 : To Log State changes and Execution Time between calls
'-----------------------------------------Parameters------------------------------------
' Restore : Value->False or Missing: Saves the State Value-> True Restores the State
' Label : Adding a Label with Restore->False logs start time and Current State to be
' ' Saved. With Restore->True logs Execution Time, Current State and Restored
' ' State values
'------------------------------------------Example--------------------------------------
' SaveAppState False, "Start Test1" ' Saves the Application State
' Application.ScreenUpdating = False ' Change the state
' 'Code Here ' Do Work
' SaveAppState True, "End Test1" ' Restores then Application State
'---------------------------------------------------------------------------------------
Public Sub SaveAppState(Optional Restore As Boolean, Optional Label As String)
 Const TIME = 0, CALC = 1, UPDATING = 2, EVENTS = 3, LINETEMPLATE = "| | | |"
 Static settings As Object
 Dim values() As Variant
 Dim line As String
 If settings Is Nothing Then Set settings = CreateObject("System.Collections.Stack")
 With Application
 If Restore Then
 If settings.Count = 0 Then
 Err.Raise 5, "Test", "The Stack is Empty " & vbCrLf & "An Application State must be Saved first."
 Exit Sub
 End If
 values = settings.Pop
 If Len(Label) > 0 Then
 Debug.Print Label; "-> Execution Time: "; Format((Timer - values(TIME)) / 86400, "hh:mm:ss")
 Debug.Print String(Len(LINETEMPLATE), "-")
 line = LINETEMPLATE: Mid(line, 6) = "Settings": Mid(line, 23) = "Old": Mid(line, 34) = "New": Debug.Print line
 line = LINETEMPLATE: Mid(line, 2) = "Calculation": Mid(line, 21) = .Calculation: Mid(line, 33) = values(CALC): Debug.Print line
 line = LINETEMPLATE: Mid(line, 2) = "ScreenUpdating": Mid(line, 21) = .ScreenUpdating: Mid(line, 33) = values(UPDATING): Debug.Print line
 line = LINETEMPLATE: Mid(line, 2) = "EnableEvents": Mid(line, 21) = .EnableEvents: Mid(line, 33) = values(EVENTS): Debug.Print line
 Debug.Print String(Len(LINETEMPLATE), "-")
 End If
 .Calculation = values(CALC)
 .ScreenUpdating = values(UPDATING)
 .EnableEvents = values(EVENTS)
 Else
 If Len(Label) > 0 Then
 Debug.Print Label; ": Started "; Format(Now, "hh:mm:ss")
 Debug.Print String(Len(LINETEMPLATE), "-")
 line = LINETEMPLATE: Mid(line, 6) = "Settings": Mid(line, 21) = "Original": Debug.Print line
 line = LINETEMPLATE: Mid(line, 2) = "Calculation": Mid(line, 22) = .Calculation: Debug.Print line
 line = LINETEMPLATE: Mid(line, 2) = "ScreenUpdating": Mid(line, 22) = .ScreenUpdating: Debug.Print line
 line = LINETEMPLATE: Mid(line, 2) = "EnableEvents": Mid(line, 22) = .EnableEvents: Debug.Print line
 Debug.Print String(Len(LINETEMPLATE), "-")
 End If
 settings.Push Array(CDbl(Timer), .Calculation, .ScreenUpdating, .EnableEvents)
 End If
 End With
End Sub

Usage

Sub Demo1()
 With Application
 SaveAppState Restore:=False, Label:="Start Demo1"
 .ScreenUpdating = False: .Calculation = xlCalculationManual: .EnableEvents = False
 .Wait (Now + TimeValue("0:00:02"))
 SaveAppState Restore:=True, Label:="End Demo1"
 End With
End Sub

Immediate Window Log

Start Demo1: Started 03:18:37
-----------------------------------------
| Settings | Original | |
|Calculation | -4105 | |
|ScreenUpdating | True | |
|EnableEvents | True | |
-----------------------------------------
End Demo1-> Execution Time: 00:00:01
-----------------------------------------
| Settings | Old | New |
|Calculation | -4135 | -4105 |
|ScreenUpdating | False | True |
|EnableEvents | False | True |
-----------------------------------------

Answer 1

Calling convention

This line all on its own tells me nothing:

AppState "Main1"

Am I saving a new state as-is or am I restoring a state? From this line alone, I can't tell!

I would prefer a more explicit action such as

AppState.Save "Main1"

and

AppState.Restore "Main1"

Now I can tell from a single line whether I'm doing the right thing or if I've written a bug in my code. I don't have to traipse all over the routine to make sure it's in right sequence.

Note that I also included the module's name which help make things even more explicit what routine I'm calling. You can treat the standard module as if it was a static singleton class and therefore have the settings dictionary be a Private object, rather than a Static variable contained within a single procedure.

If we want to be even more explicit, we can modify the Save routine to not take the settings as Optional. Which brings me to the next point:

Default values for optional parameters are nonsense

If I wrote AppState "Main1" and there weren't a key named "Main1", what would happen when the branch that saves state is run? It'd insert in 0, False, False for the parameters, which has nothing to do with the actual state it is in this moment. Furthermore, because you strong-typed your variables, you cannot use IsMissing to help you out. You'd need to do something like this:

If CalcMode = 0 Then
 CalcMode = Application.Calculation
End If
If ScreenUpdating = False Then
 ScreenUpdating = Application.ScreenUpdating
End If

which is kind of redundant if the values are already the same but you have to have those checks to support saving the state as-is.

or you can just avoid the problem altogether by forcing those 3 parameters to be non-optional, and thus force the caller to specify what state they want to be restored to.

Who should win?

The way code is, the whoever runs the last will win. Because your intention is to use this in situations where routine may be called asynchronously by Excel itself. We should keep in mind that VBA is single-threaded so it cannot ever run multiple threads concurrently. Even so, we have no guarantees about who gets to finish the last if the routines themselves gets to be called by Excel, rather than directly by other VBA code.

This is where I'm a bit unclear on what we need to achieve. If we merely want to ensure that we return to the same state we were originally at, then it might be necessary to implement a stack that won't actually restore the original state until the very last entry get popped. That way, it no longer matter who called when; only that the very first caller gets to save the original state, and the very last caller (which could be entirely other routine) gets to restore that and thus eliminate the race conditions.

But if your intention is to ensure that the last caller gets its desired state written without getting stomped on by others, the code is fine but you still don't know who gets to be the last caller. That may be important or not.

• JasonInVegas: Consider also adding an explicit AppState.Clear "StateName" action so that your branched logic can be a Select Case statement on the action. This will allow extending the set of actions further in the future. Also, without adding too much bulk, you could include a 'debug' or 'verbose' parameter then conflate the PrintAppState code into AppState itself, so it is self-reporting. -- just a thought.
• this: To clarify, @ThomasInzina I wasn't saying you need a class. You can do this all with a standard module. Call the standard module AppState, then define methods as simply Save and Restore, then fully qualify the calls as AppState.Save` / AppState.Restore -- that gives you the appearance of a singleton static class which is more appropriate given that you have to store the state.
• user109261: Very cleaver. I'll keep that in mind for future projects. Thanks again

Answer 2

(I wrote this, then noticed @this answer, still, further to...)

I might be missing something here, but one solution is reasonably trivial and infinitely re-usable, that's a class:

1. Create a Class, say clsAppState.
2. Add Fields/Data and properties, etc, for the States you want to Save/Restore.
3. Add a Method (or many Methods) that do the Save/Set and a Method to do the Restore - say clsAppState.Save and clsAppState.Restore.
4. Paste into the Method, and done.

I use this all the time. I wrote it once, years ago, and just use it as is - four lines of code in my procedures.
The only thing to be careful with, is error trapping in your procedure, so that you don't abandon the xAppState.Restore and have to reset your states manually :-)

If you want to build in timing or anything else you can do that too.
Because it is a method-local Construct and Destruct, it is stacked and you cannot mix/confuse instances.

Typically I Save/Restore:

• Active Sheet
• Active Selection
• Application.EnableEvents
• Application.ScreenUpdating
• Application.Calculation

Usage:

Sub Operate()
 Dim xAppState As clsAppState ' Declare.
 xAppState = New clsAppState ' Instance.
 xAppState.Save ' Save Current States and Set Required States.
 ' ...
 ' ... execute with error trapping
 ' ...
 xAppState.Restore ' Restore Saved States.
End Sub

I think you have more than enough info to write your own flavour...

• user109261: I class with the option to automatically restore the AppState upon termination would be a much better solution. However, I purposely used a subroutine to avoid adding another class to my project. I wish that the VBE supported packages.