Embedded Files
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
Page updated
Google Sites
Report abuse