4
\$\begingroup\$

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
\$\endgroup\$
  • 2
    \$\begingroup\$ 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. \$\endgroup\$ – FreeMan Aug 9 at 18:25
  • \$\begingroup\$ @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 \$\endgroup\$ – Mark S. Aug 9 at 18:29
  • 1
    \$\begingroup\$ 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 \$\endgroup\$ – FreeMan Aug 9 at 19:30
  • \$\begingroup\$ Create a new instance of the class prior to needing to turn everything Off, call Off, do your work, then call On. \$\endgroup\$ – FreeMan Aug 9 at 19:31
  • 1
    \$\begingroup\$ 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. \$\endgroup\$ – FreeMan Aug 9 at 19:39
3
\$\begingroup\$

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

Public Function DisableExcelDisplayUpdates()

  SetScreenUpdating False
  SetDisplayStatusBar False
  SetCalculationMethod Excel.xlCalculationManual
  SetEnableEvents False

End Function

Public Function EnableExcelDisplayUpdates()

  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

  ExcelValues.DisableExcelDisplayUpdates

  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"

  ExcelValues.EnableExcelDisplayUpdates

  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.

\$\endgroup\$
1
\$\begingroup\$

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.

enter image description here

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)
    DisableUpdates debugMsg:="enter MoveStuffToCells: destination cells " & dest.Address
    ' move my stuff
    EnableUpdates debugMsg:="exit  MoveStuffToCells"
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
'
Public Sub ReportUpdateState()
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
\$\endgroup\$
1
\$\begingroup\$

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
\$\endgroup\$
0
\$\begingroup\$

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
\$\endgroup\$
  • \$\begingroup\$ 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. \$\endgroup\$ – Greedo Aug 9 at 21:45
  • \$\begingroup\$ 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. \$\endgroup\$ – TinMan Aug 12 at 4:48
  • \$\begingroup\$ @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) \$\endgroup\$ – Mark S. Aug 12 at 14:14
  • \$\begingroup\$ @TinMan, By "fully Qualified" you mean the workbook, then worksheet then the setting, correct? \$\endgroup\$ – Mark S. Aug 12 at 14:15
  • 1
    \$\begingroup\$ @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. \$\endgroup\$ – Greedo Aug 12 at 16:32
0
\$\begingroup\$

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)
    WorksheetMap.Add Worksheet, Worksheet.DisplayPageBreaks
    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")
    CodeOptimizer.addWorksheet Sheet1
    CodeOptimizer.addWorksheet Sheet2
    CodeOptimizer.addWorksheet Sheet3
    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

Results

Immediate Window Results

\$\endgroup\$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.