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.

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...