I am a supporter of
St. Joseph's hospice.
 If you find this site useful or if it helped you, consider a small donation to
St. Joseph's, please.

Information on
St. Joseph's

JustGiving - Sponsor me now!

 

SystemState

"Any sufficiently advanced technology is indistinguishable from magic." [Arthur C. Clarke]

My friend and former colleague Jon T. created the smallest reasonable class module I have seen so far: SystemState provides an easy way to save and to restore system state variables like Calculation, ScreenUpdating and others.

Normally you write at the beginning of a VBA macro
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False

and at the end of a macro
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

With the class module SystemState you just write at the start
Dim state As SystemState
Set state = New SystemState

and at the end
Set state = Nothing 'Not even necessary - will be done automatically

[But remember: You cannot abbreviate this to "Dim state as New SystemState"!]

You can control a whole bunch of system state variables:

Variable

States

Comment (speed up with ...)

Calculation

xlCalculationAutomatic
xlCalculationManual
xlCalculationSemiautomatic

Decides whether a recalc is done after each change to any cell. Set to xlCalculationManual

Cursor

xlDefault
xlIBeam
xlNorthwestArrow
xlWait

This is just user info. Set to xlWait (hourglass) if you like - but only after having tested your code thoroughly - it is quite annoying to start debugging with an hourglass cursor

DisplayAlerts

True
False

If your macro knows what to do it is quite annoying if the system asks you whether you want to overwrite an existing file, for example. Set to False to switch off

EnableAnimations

True
False

From version  2016 onwards you can choose whether to use Excel © screen animations or not

EnableEvents

True
False

Set to False to prevent event procedures from being run

Interactive

True
False

If set to False all keyboard input will be blocked. Dangerous

PrintCommunication

True
False

From version  2010 onwards you can choose whether or not to alter page setup settings without needing to wait for the printer to respond

ScreenUpdating

True
False

Set to False to prevent screen from updating during run

StatusBar

False
"Any user info you like"

Text will show up at status bar (bottom line). Cleared if set to False

Option Explicit

#Const ApplicationVersion = 14 'Get at runtime with Val(Application.Version)

'
'This class has been developed by my friend & former colleague Jon T.
'I just changed it slightly. Any errors are mine for sure.
'08-Sep-2019 Bernd Plumhoff
'
'The class is called SystemState.
'It can of course be used in nested subroutines.
'
'This module provides a simple way to save and restore key excel
'system state variables that are commonly changed to speed up VBA code
'during long execution sequences.
'
'
'Usage:
'    Save() is called automatically on creation and Restore() on destruction
'    To create a new instance:
'        Dim state as SystemState
'        Set state = New SystemState
'    Warning:
'        "Dim state as New SystemState" does NOT create a new instance
'
'
'    Those wanting to do complicated things can use extended API:
'
'    To save state:
'       Call state.Save()
'
'    To restore state and in cleanup code: (can be safely called multiple times)
'       Call state.Restore()
'
'    To restore Excel to its default state (may upset other applications)
'       Call state.SetDefaults()
'       Call state.Restore()
'
'    To clear a saved state (stops it being restored)
'       Call state.Clear()
'
Private Type m_SystemState
    Calculation As XlCalculation
    Cursor As XlMousePointer
    DisplayAlerts As Boolean
#If ApplicationVersion > 15 Then
    EnableAnimations As Boolean   'From Excel 2016 onwards
#End If
    EnableEvents As Boolean
    Interactive As Boolean
#If ApplicationVersion > 12 Then
    PrintCommunication As Boolean 'From Excel 2010 onwards
#End If
    ScreenUpdating As Boolean
    StatusBar As Variant
    m_saved As Boolean
End Type

'
'Instance local copy of m_State?
'
Private m_State As m_SystemState

'
'Reset a saved system state to application defaults
'Warning: restoring a reset state may upset other applications
'
Public Sub SetDefaults()
    m_State.Calculation = xlCalculationAutomatic
    m_State.Cursor = xlDefault
    m_State.DisplayAlerts = True
#If ApplicationVersion > 15 Then
    m_State.EnableAnimations = True
#End If
    m_State.EnableEvents = True
    m_State.Interactive = True
#If ApplicationVersion > 12 Then
    m_State.PrintCommunication = True
#End If
    m_State.ScreenUpdating = True
    m_State.StatusBar = False
    m_State.m_saved = True 'Effectively we saved a default state
End Sub

'
'Clear a saved system state (stop restore)
'
Public Sub Clear()
    m_State.m_saved = False
End Sub

'
'Save system state
'
Public Sub Save(Optional SetFavouriteParams As Boolean = False)
    If Not m_State.m_saved Then
        m_State.Calculation = Application.Calculation
        m_State.Cursor = Application.Cursor
        m_State.DisplayAlerts = Application.DisplayAlerts
#If ApplicationVersion > 15 Then
        m.EnableAnimations = Application.EnableAnimations
#End If
        m_State.EnableEvents = Application.EnableEvents
        m_State.Interactive = Application.Interactive
#If ApplicationVersion > 12 Then
        m_State.PrintCommunication = Application.PrintCommunication
#End If
        m_State.ScreenUpdating = Application.ScreenUpdating
        m_State.StatusBar = Application.StatusBar
        m_State.m_saved = True
    End If
    If SetFavouriteParams Then
        Application.Calculation = xlCalculationManual
        'Application.Cursor = xlDefault  'Dont - unnecessary
        Application.DisplayAlerts = False
#If ApplicationVersion > 15 Then
        Application.EnableAnimations = False
#End If
        Application.EnableEvents = False
        'Application.Interactive = False 'Dont - dangerous
#If ApplicationVersion > 12 Then
        Application.PrintCommunication = False
#End If
        Application.ScreenUpdating = False
        Application.StatusBar = False
    End If
End Sub

'
'Restore system state
'
Public Sub Restore()
    If m_State.m_saved Then
        'We check now before setting Calculation because setting
        'Calculation will clear cut/copy buffer
        If Application.Calculation <> m_State.Calculation Then
            Application.Calculation = m_State.Calculation
        End If
        Application.Cursor = m_State.Cursor
        Application.DisplayAlerts = m_State.DisplayAlerts
#If ApplicationVersion > 15 Then
        Application.EnableAnimations = m_State.EnableAnimations
#End If
        Application.EnableEvents = m_State.EnableEvents
        Application.Interactive = m_State.Interactive
#If ApplicationVersion > 12 Then
        Application.PrintCommunication = m_State.PrintCommunication
#End If
        Application.ScreenUpdating = m_State.ScreenUpdating
        If m_State.StatusBar = "FALSE" Then
            Application.StatusBar = False
        Else
            Application.StatusBar = m_State.StatusBar
        End If
    End If
End Sub
 
'
'By default save when we are created
'
Private Sub Class_Initialize()
    Call Save(SetFavouriteParams:=True)
End Sub
 
'
'By default restore when we are destroyed
'
Private Sub Class_Terminate()
    Call Restore
End Sub

If you are interested in downloading a 27 KB Excel 2010 sample file go to my Download page, please.

A simple and naive speedup approach which does not store the system states you can find here.

Sulprobil   Get it done   Contact   Disclaimer   Impressum   Download