clsSettings()

Speeding up VBA
This is one of the easiest and most impactful ways that we can speed up VBA by temporarily turning off some of Excel's features such as:

  • Calculating Cells

  • Responding to Windows events

  • Screen updating

Speeding VBA isn't the only use for this routine. We can use this within an event, such as a worksheet change event, to prevent whatever the routine does to its worksheet from triggering another worksheet change event and thus sending our program into a loop that terminates when Excel runs out of memory. I also use this to remove protection to enable VBA functions that will not work when worksheet or workbook protection is on.

This class's magic is all we have to do is instantiate it from within a procedure like so:

Dim oSettings as clsSettings

Set oSettings = New clsSettings

When we instantiate our class, the Class_Initialize() event automatically runs which disables those Excel features and removes protection. And when our routine ends, our class 'goes out of scope' causing the Class_Terminate() event to automatically run which reverses everything the Class_Initialize() did.

NOTE! We should only use this as needed because over use of this routine can reverse the desired effect and degrade performance.

Now that we know what this does, let's see how to code it.

' Version: 11/14/18

' Save As: clsSettings

' Description:Save, Set and Restore System Settings

' @Craig Hatmaker 08/07/2013

' Others may not claim credit for, nor sell this.

' Others may copy, modify, and distribute freely.


' NOTE! To make one of my existing routines into a class is inspired

' by the work of Bern Plumoff and Jon T. Any of this work that

' overlaps their work is not copy protected by me.

' See: http://www.sulprobil.com/Get_it_done/IT/Excel_Fun/Excel_VBA/VBA_Intro/ _

VBA_08_Optimization/SystemState/systemstate.html


' Example:Dim oSettings as clsSettings

' Set oSettings = New clsSettings


' Date Ini Modification

' 08/16/13 CWH Modified for Class and to include coding standards

' 09/06/13 CWH Moved Class_Terminate before Class_Initialize

' 10/28/13 CWH Added Clipboard restoration after changing calculation

' 10/22/14 CWH Changed sRoutine to cRoutine

' 10/31/16 CWH Workbook Protection

' 02/08/18 CWH Changed name for protection to match modGeneral.Protection

' 11/02/18 CWH Unprotect ALL worksheets

' 11/14/18 CWH Standardized variable names


Option Explicit


Public WithEvents Worksheet As Worksheet


Private Const cModule As String = "clsSettings" 'Class module's name for error handling

Private oWkb As Workbook 'Active Workbook

Private oSheets As Object 'Worksheets Dictionary

Private oSheet As Object 'Current worksheet

Private lSheetType As Long 'Worksheet or Chartsheet

Private sSheetName As String 'Worksheet's name

Private lCalculation As XlCalculation 'Calculation State

Private bEnableEvents As Boolean 'Events State

Private bScreenUpdating As Boolean 'Screen Updating State

Private bProtectContents As Boolean 'Protect Contents State

Private bProtectStructure As Boolean 'Protect Structure State

Private bProtectWindows As Boolean 'Protect Windows State

Private sPassword As String 'Protection Password

Instantiating the Class
When we assign a variable to the class module, this procedure runs.

It sets some global variables, then attempts to retrieve the protection password from a name (hopefully hidden) object. We must set that named object if we use protection and want this routine to turn it on and off as needed.

The next task is save all settings by calling the Save() procedure, then calling the Disable() procedure to disable those things that impact performance unnecessarily.

Private Sub Class_Initialize()

Set oWkb = ActiveWorkbook

Set oSheets = CreateObject("Scripting.Dictionary")

With ActiveSheet

If Not IsError(.Evaluate("PWD" & .Name)) Then _

sPassword = Evaluate("PWD" & .Name)

End With

Save

Disable

End Sub

Terminating the Class
When the procedure that instantiated our class ends, the variable used to hold our class 'goes out of scope' which, in essence, sets our variable to nothing. That causes our class to terminate and run this procedure. All this procedure does is restore all settings to the state they were in when this class was instantiated by calling procedure Restore().

Private Sub Class_Terminate()

Restore

End Sub

Save Settings
This procedure returns all settings to the state they had when our class was instantiated.

Private Sub Save()


' Description:Save System Settings

' Inputs: *None

' Outputs: *None

' Requisites: *None

' Example: *None


' Date Ini Modification

' 08/16/13 CWH Initial Development

' 10/31/16 CWH Workbook Protection


' Declarations

Const cRoutine As String = "Save"

Dim oWks As Worksheet


' Error Handling Initialization

On Error GoTo ErrHandler


' Procedure

Set oSheet = ActiveSheet

lSheetType = ActiveSheet.Type

sSheetName = ActiveSheet.Name

bEnableEvents = Application.EnableEvents

bScreenUpdating = Application.ScreenUpdating

lCalculation = Application.Calculation

Application.ScreenUpdating = False

For Each oWks In oWkb.Worksheets

oSheets(oWks.Name) = oWks.ProtectContents

Next

Application.ScreenUpdating = bScreenUpdating

bProtectStructure = oWkb.ProtectStructure

bProtectWindows = oWkb.ProtectWindows



ErrHandler:

Select Case Err.Number

Case Is = NoError: 'Do nothing

Case Else:

Select Case DspErrMsg(cModule & "." & cRoutine)

Case Is = vbAbort: Stop: Resume 'Debug mode - Trace

Case Is = vbRetry: Resume 'Try again

Case Is = vbIgnore: 'End routine

End Select

End Select


End Function

Disable Settings
This procedure disables all Excel features that slow down VBA needlessly.

Private Sub Disable()


' Description:Disable System Settings

' Inputs: *None

' Outputs: *None

' Requisites: *None

' Example: *None


' Date Ini Modification

' 08/16/13 CWH Initial Development

' 10/31/16 CWH Workbook Protection


' Declarations

Const cRoutine As String = "Disable"

Dim vKey As Variant


' Error Handling Initialization

On Error GoTo ErrHandler


' Procedure

Application.EnableEvents = False

Application.ScreenUpdating = False

OpenClipboard 0

Application.Calculation = xlCalculationManual

CloseClipboard

For Each oWks In oWkb.Worksheets

oWks.Unprotect sPassword

Next

oWkb.Unprotect sPassword


ErrHandler:

Select Case Err.Number

Case Is = NoError: 'Do nothing

Case Is = 1004: Resume Next

Case Else:

Select Case DspErrMsg(cModule & "." & cRoutine)

Case Is = vbAbort: Stop: Resume 'Debug mode - Trace

Case Is = vbRetry: Resume 'Try again

Case Is = vbIgnore: 'End routine

End Select

End Select


End Function

Restore Settings
This procedure returns all settings to the state they had when our class was instantiated.

Private Sub Restore()


' Description:Restore System Settings

' Inputs: *None

' Outputs: *None

' Requisites: *None

' Example: *None


' Date Ini Modification

' 08/16/13 CWH Initial Development

' 10/31/16 CWH Workbook Protection


' Declarations

Const cRoutine As String = "Restore"

Dim vKey As Variant


' Error Handling Initialization

On Error GoTo ErrHandler


' Procedure

oSheet.Activate

Application.EnableEvents = bEnableEvents

Application.Calculation = lCalculation

Application.ScreenUpdating = False

For Each vKey In oSheets

If oSheets(vKey) Then _

Worksheets(vKey).Protect sPassword Else _

Worksheets(vKey).Unprotect sPassword

Next

Application.ScreenUpdating = bScreenUpdating

If bProtectStructure Or bProtectContents Then _

oWkb.Protect sPassword, bProtectStructure, bProtectWindows


ErrHandler:

Select Case Err.Number

Case Is = NoError: 'Do nothing

Case Is = 9, 424, 1004: Resume Next

Case Else:

Select Case DspErrMsg(cModule & "." & cRoutine)

Case Is = vbAbort: Stop: Resume 'Debug mode - Trace

Case Is = vbRetry: Resume 'Try again

Case Is = vbIgnore: 'End routine

End Select

End Select


End Function