# Turn On/Off Functions to speed things up

I have these two macros that are like my Yin & Yang. They turn off and on functions in excel so my macros calculate quicker.

I call on in the beginning and one at the end.

Is there anything I can do or add to these to make them better?

Private Sub TurnOffFunctions()

Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False

End Sub

Private Sub TurnOnFunctions()

Application.ScreenUpdating = True
Application.DisplayStatusBar = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True

End Sub

• TurnOff could save the initial state of those 4 items and TurnOn could reset to that state instead of assuming what the user had. Also, don't rely on them as a crutch expecting them to make everything faster. Sometimes there are structural issues in code that can have a far larger impact on processing speed (like copying a .Range to an array of Variant, doing calculations on the array, then copying it back). Never forget that ScreenUpdating = False and DisplayStatusBar = False can hide issues making debugging more difficult. – FreeMan Aug 9 at 18:25
• @FreeMan thanks for the tip, do you know how I'd go about saving the current setting then resetting them? I'm the primary user so these are my default, but it would be nice to have this work for any user. I'd also like to defend myself and say this isn't my crutch but something I add to code once it's all set and debugged on simple calculations such as looping down a table with a goalseek or something – Mark S. Aug 9 at 18:29
• You could create a Class with these as properties, and 2 methods On and Off. The Off method gets the current value of each, stores it in the appropriate property, then sets them to False as in your current TurnOff procedure. The On sets the Application property based on what is stored in the class – FreeMan Aug 9 at 19:30
• Create a new instance of the class prior to needing to turn everything Off, call Off, do your work, then call On. – FreeMan Aug 9 at 19:31
• No, sorry, that was Application.<something>. I short-handed it, which wasn't clear enough. I'll whip up a sample and post an answer. – FreeMan Aug 9 at 19:39

You should save the initial state of the Application.* variables before you mess with them, then reset them when you're done. Not all of your users will have the same settings and it's rude to assume they do.

A simple way to do it would be to implement a class like this:

'@Folder("Classes")
Option Explicit

Private Type ApplicationSettings
ScreenUpdating As Boolean
DisplayStatusBar As Boolean
CalculationMethod As Excel.XlCalculation
EnableEvents As Boolean
End Type

Private this As ApplicationSettings

Public Property Get ScreenUpdating() As Boolean
ScreenUpdating = this.ScreenUpdating
End Property

Public Property Get DisplayStatusBar() As Boolean
DisplayStatusBar = this.DisplayStatusBar
End Property

Public Property Get CalculationMethod() As Excel.XlCalculation
CalculationMethod = this.CalculationMethod
End Property

SetScreenUpdating False
SetDisplayStatusBar False
SetCalculationMethod Excel.xlCalculationManual
SetEnableEvents False

End Function

Application.ScreenUpdating = this.ScreenUpdating
Application.DisplayStatusBar = this.DisplayStatusBar
Application.Calculation = this.CalculationMethod
Application.EnableEvents = this.EnableEvents

End Function

Private Function SetScreenUpdating(ByVal value As Boolean)
this.ScreenUpdating = Application.ScreenUpdating
Application.ScreenUpdating = value
End Function

Private Function SetDisplayStatusBar(ByVal value As Boolean)
this.DisplayStatusBar = Application.DisplayStatusBar
Application.DisplayStatusBar = value
End Function

Private Function SetCalculationMethod(ByVal value As Excel.XlCalculation)
this.CalculationMethod = Application.Calculation
Application.Calculation = value
End Function

Private Function SetEnableEvents(ByVal value As Boolean)
this.EnableEvents = Application.EnableEvents
Application.EnableEvents = value
End Function


Then test it out like this:

Option Explicit
@Folder("Tests")

Public Sub testIt()

Dim ExcelValues As Class1
Set ExcelValues = New Class1

Debug.Print "Before "
Debug.Print "ScreenUpdating: " & Application.ScreenUpdating
Debug.Print "DisplayStatusBar: " & Application.DisplayStatusBar
Debug.Print "Calculation: " & Application.Calculation
Debug.Print "EnableEvents: " & Application.EnableEvents

Debug.Print "During "
Debug.Print "ScreenUpdating: " & Application.ScreenUpdating
Debug.Print "DisplayStatusBar: " & Application.DisplayStatusBar
Debug.Print "Calculation: " & Application.Calculation
Debug.Print "EnableEvents: " & Application.EnableEvents

MsgBox "Do your long running process here"

Debug.Print "After "
Debug.Print "ScreenUpdating: " & Application.ScreenUpdating
Debug.Print "DisplayStatusBar: " & Application.DisplayStatusBar
Debug.Print "Calculation: " & Application.Calculation
Debug.Print "EnableEvents: " & Application.EnableEvents

End Sub


*Note that the '@Folder("<something>") annotation is a feature of Rubberduck which is a great tool for helping to improve your VBA code. I'm an avid user and occasional contributor to the OSS project.

Probably the single, most-used module in my personal library is Lib_PerformanceSupport, which helps to manage Application level performance controls. I designed (evolved) the methods in a way that they can be sprinkled liberally through the code and reused easily, even when nested. Though I could have designed this as a persistent object, it's implemented as a single module with function calls to avoid a requirement to keep track of an object's scope.

The idea is that as my code breaks down into a variety of routines, a good percentage of these will benefit from disabling and reenabling performance controls. Since I strive to design the routines with reuse in mind, I can (almost) never know for certain if the performance control calls are nested or how deeply.

My design for this uncertainty adds a depth counter to the functions that will reset the performance controls to their original state only when execution control is returned to the original caller.

Certainly this can present a problem in handling exceptions, leaving all the performance controls disabled. But you have this problem regardless of how you're dealing with those controls. Designing for and handling errors for your application is a separate question.

I've also added a DEBUG_MODE flag as an application level/compile time option for those situations when you want to know where your code has gone off the rails for debugging. So from the example above, the calls might be:

Sub MoveStuffToCells(ByRef dest As Range)
' move my stuff
End Sub


A bonus set of functions in the module use the Windows QueryPerformanceCounter function in the kernel as a microsecond precision timer.

The module is presented as a .bas file. So copy/pasta the code below into a text file with the .bas extension, then import the file into your VBA Editor.

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

Private Declare Function QueryPerformanceCounter Lib _
"kernel32" (lpPerformanceCount As LargeInteger) As Long
Private Declare Function QueryPerformanceFrequency Lib _
"kernel32" (lpFrequency As LargeInteger) As Long

Private counterStart As LargeInteger
Private counterEnd As LargeInteger
Private crFrequency As Double

Private Const TWO_32 = 4294967296#               ' = 256# * 256# * 256# * 256#

'==============================================================================
' Screen and Event Update Controls
'
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 debugMsg As String = vbNullString, _
Optional 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 debugMsg As String = vbNullString, _
Optional 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
' from: https://stackoverflow.com/a/198702/4717755
'
Private Function LI2Double(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
QueryPerformanceCounter counterEnd
crStart = LI2Double(counterStart)
crStop = LI2Double(counterEnd)
TimeElapsed = 1000# * (crStop - crStart) / crFrequency
End Function


Here is yet another approach, a fair bit simpler, albeit less robust than other solutions. The upside with this approach, is you only have to remember one Sub name to call, then just add a boolean parameter to enable/disable optimizations.

Public Sub OptimizeExcel(Optional EnableOptimizations as Boolean = True)
With Application
.ScreenUpdating = Not EnableOptimizations
.Calculcation = iif(EnableOptimizations,xlCalculationManual,xlCalculationAutomatic)
.DisplayStatusBar = Not EnableOptimizations
.EnableEvents = Not EnableOptimizations
.EnableAnimations = Not EnableOptimizations
End With
End Sub


Usage

Public Sub MyMacro()
OptimizeExcel
...DoStuff...
OptimizeExcel False
End Sub


I found the following in the VBAVault which addresses what FreeMan spoke about but I think it's a simpler way of doing the same thing.

Public CalcState As Long
Public EventState As Boolean
Public PageBreakState As Boolean

Sub OptimizeCode_Begin()

Application.ScreenUpdating = False

EventState = Application.EnableEvents
Application.EnableEvents = False

CalcState = Application.Calculation
Application.Calculation = xlCalculationManual

PageBreakState = ActiveSheet.DisplayPageBreaks
ActiveSheet.DisplayPageBreaks = False

End Sub

Sub OptimizeCode_End()

ActiveSheet.DisplayPageBreaks = PageBreakState
Application.Calculation = CalcState
Application.EnableEvents = EventState
Application.ScreenUpdating = True

End Sub

• Those _Begin and _End methods are just crying out to be _Initialize and _Terminate events of a class. Speaking of which, the underscore is usually reserved for events (or interface members), and can lead to headaches later on if it is used for naming standard methods. – Greedo Aug 9 at 21:45
• Using ActiveSheet.DisplayPageBreaks is not that useful. A key best practice is that Objects should be fully qualified whenever possible.. For this reason, the state of each worksheet's DisplayPageBreaks should be saved and restored. – TinMan Aug 12 at 4:48
• @Greedo When you say _Initialize and _Terminate, is it as simple as switching out those words? What is the benefit to those over these? Also with the underscore thing, is that just better coding practice or functionally different. I'm a little basic still so I'm trying to sort this stuff out and swat out bad habits, but with how short my codes are I feel like maintenance would be still minor and the underscore doesn't effect much (but surely I could be convinced otherwise) – Mark S. Aug 12 at 14:14
• @TinMan, By "fully Qualified" you mean the workbook, then worksheet then the setting, correct? – Mark S. Aug 12 at 14:15
• @MarkS. ... By creating methods in a class with the unique names Class_Initialize & Class_Terminate your code will run on the respective events of the class. Why you might want to do this? You can set and revert state by creating and destroying an object, meaning if you forget to run the _End code it will run automatically anyway. See (the end) of this answer to a similar question. Regarding the underscore; you can't Implement methods with underscores. Mostly though it breaks the Object_Method convention used everywhere else. – Greedo Aug 12 at 16:32

The question asked by the OP boils down to "How to make the macros work quicker". To that end the only optimization that you commonly see that isn't included in the OP's macros is Worksheet.DisplayPageBreaks.

I have answered and tackled this problem several times and feel that timing a procedure goes hand in hand to the code optimizations and have tried to address both in the class below.

## VBACodeOptimizer:Class

Uses my spin on Matt's factory method to time and optimize macros. The purpose of the class is to save and restore the settings between one or more nested macros. The first macro may need to turn off the Optimizations where nested macros may need these settings turned on.

In retrospect it seems like many of the properties have an unclear usage. For example: it is not clear where the ScreenUpdating() property is to used to store the return the original Application.ScreenUpdating value.

VERSION 1.0 CLASS
Attribute VB_Name = "VBACodeOptimizer"

Attribute VB_PredeclaredId = True

Option Explicit

Private Type Members
Calculation As XlCalculation
CleanUpMessage As String
EnableEvents As Boolean
ScreenUpdating As Boolean
TimeProcedure As Boolean
End Type

Private m As Members
Private WorksheetMap As New Scripting.Dictionary
Private StartTime As Double

Private Sub Class_Terminate()
If Len(m.CleanUpMessage) > 0 Then Debug.Print m.CleanUpMessage
If m.TimeProcedure Then Debug.Print "Run Time in Seconds: "; getRunTime
End Sub

Public Function Self() As VBACodeOptimizer
Set Self = Me
End Function

Public Function Create(Optional ByVal CleanUpMessage As String, Optional ByVal TimeProcedure As Boolean = True, Optional ByVal ApplyOptimizations As Boolean = True) As VBACodeOptimizer
With New VBACodeOptimizer
Set Create = .Self
.CleanUpMessage = CleanUpMessage
.TimeProcedure = TimeProcedure
If TimeProcedure Then .setStartTime
If ApplyOptimizations Then .Apply
End With
End Function

Public Sub addWorksheet(ByRef Worksheet As Worksheet, Optional ByVal DisplayPageBreaks As Boolean = True)
If DisplayPageBreaks Then Worksheet.DisplayPageBreaks = False
End Sub

Public Sub Apply()
Dim item As Variant
For Each item In WorksheetMap
item.DisplayPageBreaks = False
Next
End Sub

Public Function getRunTime(Optional Precision As Long = 2) As Double
getRunTime = Round(Timer - StartTime, Precision)
End Function

Public Function getStartTime() As Double
getStartTime = StartTime
End Function

Public Sub setStartTime()
StartTime = Timer
End Sub

Public Sub Save()
With Application
'Save Events
Calculation = .Calculation
EnableEvents = .EnableEvents
ScreenUpdating = .ScreenUpdating

'Optimize Events
.Calculation = XlCalculation.xlCalculationManual
.EnableEvents = False
.ScreenUpdating = False
End With
End Sub

Public Sub Restore()
With Application
.Calculation = Calculation
.EnableEvents = EnableEvents
.ScreenUpdating = ScreenUpdating
End With

Dim item As Variant
For Each item In WorksheetMap
item.DisplayPageBreaks = WorksheetMap(item)
Next
End Sub

Public Property Get Calculation() As XlCalculation
Calculation = m_bCalculation
End Property

Public Property Let Calculation(ByVal Value As XlCalculation)
m.Calculation = Value
End Property

Public Property Get CleanUpMessage() As String
CleanUpMessage = m.CleanUpMessage
End Property

Public Property Let CleanUpMessage(ByVal Value As String)
m.CleanUpMessage = Value
End Property

Public Property Get EnableEvents() As Boolean
EnableEvents = m.EnableEvents
End Property

Public Property Let EnableEvents(ByVal Value As Boolean)
m.EnableEvents = Value
End Property

Public Property Get ScreenUpdating() As Boolean
ScreenUpdating = m.ScreenUpdating
End Property

Public Property Let ScreenUpdating(ByVal Value As Boolean)
m.ScreenUpdating = Value
End Property

Public Property Get TimeProcedure() As Boolean
TimeProcedure = m.TimeProcedure
End Property

Public Property Let TimeProcedure(ByVal Value As Boolean)
m.TimeProcedure = Value
End Property


## Test

This tests are show the basic use of the class but there are other nuances to it that can be useful. One such use case would be use the getRunTime() function to support a "Do you wish to Continue" message.

Sub Main()
Dim CodeOptimizer As VBACodeOptimizer
Set CodeOptimizer = VBACodeOptimizer.Create("Main")
Macro1
Macro2
End Sub

Sub Macro1()
Dim CodeOptimizer As VBACodeOptimizer
Set CodeOptimizer = VBACodeOptimizer.Create("Macro1")
Application.Wait Now + TimeValue("0:00:01")
Macro2
End Sub

Sub Macro2()
Dim CodeOptimizer As VBACodeOptimizer
Set CodeOptimizer = VBACodeOptimizer.Create("Macro2")
Application.Wait Now + TimeValue("0:00:01")
End Sub
`