Skip to main content
Tweeted twitter.com/StackCodeReview/status/947216659835695105
added 2263 characters in body
Source Link
user109261
user109261

I refactored my code reading @this post and @jasoninvegas comments. I'll try and elaborate later tonight.

'---------------------------------------------------------------------------------------
' 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
                MsgBoxErr.Raise 5, "Test", "The Stack is Empty"Empty " & vbCrLf & Label,"An vbCriticalApplication 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, 2123) = "Old": Mid(line, 2934) = "New": Debug.Print line
                line = LINETEMPLATE: Mid(line, 2) = "Calculation": Mid(line, 1921) = .Calculation: Mid(line, 3133) = values(CALC): Debug.Print line
                line = LINETEMPLATE: Mid(line, 2) = "ScreenUpdating": Mid(line, 1921) = .ScreenUpdating: Mid(line, 3133) = values(UPDATING): Debug.Print line
                line = LINETEMPLATE: Mid(line, 2) = "EnableEvents": Mid(line, 1921) = .EnableEvents: Mid(line, 3133) = 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, 1921) = "Original": Debug.Print line
                line = LINETEMPLATE: Mid(line, 2) = "Calculation": Mid(line, 1922) = .Calculation: Debug.Print line
                line = LINETEMPLATE: Mid(line, 2) = "ScreenUpdating": Mid(line, 1922) = .ScreenUpdating: Debug.Print line
                line = LINETEMPLATE: Mid(line, 2) = "EnableEvents": Mid(line, 1922) = .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    |
-----------------------------------------

I refactored my code reading @this post and @jasoninvegas comments. I'll try and elaborate later tonight.

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
                MsgBox "The Stack is Empty" & vbCrLf & Label, vbCritical
                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, 21) = "Old": Mid(line, 29) = "New": Debug.Print line
                line = LINETEMPLATE: Mid(line, 2) = "Calculation": Mid(line, 19) = .Calculation: Mid(line, 31) = values(CALC): Debug.Print line
                line = LINETEMPLATE: Mid(line, 2) = "ScreenUpdating": Mid(line, 19) = .ScreenUpdating: Mid(line, 31) = values(UPDATING): Debug.Print line
                line = LINETEMPLATE: Mid(line, 2) = "EnableEvents": Mid(line, 19) = .EnableEvents: Mid(line, 31) = 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, 19) = "Original": Debug.Print line
                line = LINETEMPLATE: Mid(line, 2) = "Calculation": Mid(line, 19) = .Calculation: Debug.Print line
                line = LINETEMPLATE: Mid(line, 2) = "ScreenUpdating": Mid(line, 19) = .ScreenUpdating: Debug.Print line
                line = LINETEMPLATE: Mid(line, 2) = "EnableEvents": Mid(line, 19) = .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

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    |
-----------------------------------------
added 2655 characters in body
Source Link
user109261
user109261

Addendum

I refactored my code reading @this post and @jasoninvegas comments. I'll try and elaborate later tonight.

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
                MsgBox "The Stack is Empty" & vbCrLf & Label, vbCritical
                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, 21) = "Old": Mid(line, 29) = "New": Debug.Print line
                line = LINETEMPLATE: Mid(line, 2) = "Calculation": Mid(line, 19) = .Calculation: Mid(line, 31) = values(CALC): Debug.Print line
                line = LINETEMPLATE: Mid(line, 2) = "ScreenUpdating": Mid(line, 19) = .ScreenUpdating: Mid(line, 31) = values(UPDATING): Debug.Print line
                line = LINETEMPLATE: Mid(line, 2) = "EnableEvents": Mid(line, 19) = .EnableEvents: Mid(line, 31) = 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, 19) = "Original": Debug.Print line
                line = LINETEMPLATE: Mid(line, 2) = "Calculation": Mid(line, 19) = .Calculation: Debug.Print line
                line = LINETEMPLATE: Mid(line, 2) = "ScreenUpdating": Mid(line, 19) = .ScreenUpdating: Debug.Print line
                line = LINETEMPLATE: Mid(line, 2) = "EnableEvents": Mid(line, 19) = .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

Addendum

I refactored my code reading @this post and @jasoninvegas comments. I'll try and elaborate later tonight.

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
                MsgBox "The Stack is Empty" & vbCrLf & Label, vbCritical
                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, 21) = "Old": Mid(line, 29) = "New": Debug.Print line
                line = LINETEMPLATE: Mid(line, 2) = "Calculation": Mid(line, 19) = .Calculation: Mid(line, 31) = values(CALC): Debug.Print line
                line = LINETEMPLATE: Mid(line, 2) = "ScreenUpdating": Mid(line, 19) = .ScreenUpdating: Mid(line, 31) = values(UPDATING): Debug.Print line
                line = LINETEMPLATE: Mid(line, 2) = "EnableEvents": Mid(line, 19) = .EnableEvents: Mid(line, 31) = 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, 19) = "Original": Debug.Print line
                line = LINETEMPLATE: Mid(line, 2) = "Calculation": Mid(line, 19) = .Calculation: Debug.Print line
                line = LINETEMPLATE: Mid(line, 2) = "ScreenUpdating": Mid(line, 19) = .ScreenUpdating: Debug.Print line
                line = LINETEMPLATE: Mid(line, 2) = "EnableEvents": Mid(line, 19) = .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
added 238 characters in body
Source Link
user109261
user109261
Public Sub AppState(Key As String, Optional CalcMode As XlCalculation, Optional ScreenUpdating As Boolean, Optional EnableEvents As Boolean)
    Const timeTIME = 0, calcCALC = 1, updatingUPDATING = 2, eventsEVENTS = 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)(timeTIME)) / 86400, "hh:mm:ss")
            Debug.Print String(20, "-")
            
            .Calculation = settings(Key)(calcCALC)
            .ScreenUpdating = settings(Key)(updatingUPDATING)
            .EnableEvents = settings(Key)(eventsEVENTS)
            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

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.

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

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.

Source Link
user109261
user109261
Loading