Application[]
ScreenUpdating[]
Disabling ScreenUpdating stops any changes/operations from being displayed on-screen, which hugely increases performance during large operations.
To use this, disable ScreenUpdating at the start of your submodule or function, then enable it at the end. Note that message and error boxes will still be displayed.
Also see #Disable Calculation.
- Disable ScreenUpdating
Application.ScreenUpdating = False
- Enable ScreenUpdating
Application.ScreenUpdating = True
- Example
This example remembers the current value for ScreenUpdating, disables it, then later restores it back to the original value. It creates two functions: DisableScreenUpdating and EnableScreenUpdating.
'@val - Boolean value, The Previous Setting for "ScreenUpdating"
'Notes:
' - @val is passed in case of nested methods that use this method.
Function DisableScreenUpdating(val As Boolean) As Boolean
'''''''''''''''''''''''''''''''''''''''''''''''''
' Disable ScreenUpdating, for seamless operation
If val Then
Application.ScreenUpdating = False
End If
'''''''''''''''''''''''''''''''''''''''''''''''''
DisableScreenUpdating = val
End Function
Function EnableScreenUpdating(val As Boolean)
If val Then
Application.ScreenUpdating = True
End If
End Function
Manual Calculation[]
Disabling automatic calculations allows for large cell operations to be conducted, without the entire spreadsheet recalculating each time. For example, sorting many rows or copying large quantities of data into the spreadsheet.
This will increase the performance of the operation, and can also be disabled for the user to manually use the spreadsheet without triggering recalculations. Calculations can then be manually started with the F9 key, or by other code, or setting it back to manual.
- Set calculation to manual
Application.Calculation = xlCalculationManual
- Set calculation to automatic
Application.Calculation = xlCalculationAutomatic
- Perform manual full recalculation
'For all open workbooks
Application.Calculate
'For a specific worksheet
Worksheets("Sheet1").Calculate
'For a specific range only
Worksheets("Sheet1").Range("A1:D4").Calculate
- Full example functions
'Disable AutoCalculation
'Store current setting and set calculations to manual
Function CalculationOff() As XlCalculation
Dim appcalc As XlCalculation: appcalc = Application.Calculation
Application.Calculation = xlCalculationManual
CalculationOff = appcalc
End Function
'Restore to original setting
Function CalculationOn(appcalc As XlCalculation)
Application.Calculation = appcalc
If appcalc <> xlCalculationManual Then
Application.CalculateFullRebuild
End If
End Function
General[]
String[]
- Returns the trailing numbers of a string as Long data-type.
'@val - String value, A string ending in numbers
'Notes:
' - The string of numbers at the end needs to be no more than the max value for Long
' Data type, otherwise an OutOfBounds or OutOfRange exception might be thrown.
Function GetTrailingNumericValue(val As String) As Long
Dim i As Long, tmp As Variant, ret As Variant
For i = Len(val) To 1 Step -1
tmp = mid(val, i, 1)
If IsNumeric(tmp) Then
ret = tmp & ret
Else
Exit For
End If
Next
GetNumericValue = ret
End Function
- Checks whether the String value is Empty or Nothing. Solves the problem with the lack of this method being available in VBA.
'Returns a Boolean value of whether the
'@val - String value, Text to verify
'Notes:
' - This method is very useful in If Statements where you want to
' verify that a String value is not Empty or Nothing.
Function IsNullOrEmpty(val As String) As Boolean
'First conditional validates for Nothing
'Second condition validates for an Empty String situation "" or " "
If (val & "" = "") Or (Len(Trim(val)) <= 0) Then
IsNullOrEmpty = True
Else
IsNullOrEmpty = False
End If
End Function
Workbook[]
Microsoft Excel/Excel 2010/Snippets/Workbook
Worksheet[]
Macros[]
- Check to see if a Macro Exists in CodeModule of a Worksheet.[1]
'=================================================================================
'- CHECK IF A MODULE & SUBROUTINE EXISTS
'- VBA constant : vbext_pk_Proc = All procedures other than property procedures.
'- An error is generated if the Module or Sub() does not exist - so we trap them.
'---------------------------------------------------------------------------------
'- VB Editor : Tools/References - add reference TO ......
'- .... "Microsoft Visual Basic For Applications Extensibility"
'----------------------------------------------------------------------------------
'- Brian Baulsom October 2007
'- http://www.cpearson.com/excel/vbe.aspx
'==================================================================================
Function MacroExists(ws As Worksheet, proc As String) As Boolean
Dim cmod As VBIDE.CodeModule
Dim num As Long 'max lines in a codemodule
Dim procname As String
Dim curwb As Workbook: Set curwb = ws.Parent
On Error Resume Next
Set cmod = curwb.VBProject.VBComponents(ws.CodeName).CodeModule
On Error GoTo 0
num = cmod.CountOfDeclarationLines + 1
Do Until num >= cmod.CountOfLines
procname = cmod.ProcOfLine(num, VBIDE.vbext_pk_Proc)
num = cmod.ProcStartLine(procname, vbext_pk_Proc) + cmod.ProcCountLines(procname, vbext_pk_Proc) + 1
If procname = proc Then
MacroExists = True
Exit Function
End If
Loop
MacroExists = False
End Function
UniqueValues[]
- Returns a Variant Array of values that are unique to the specified Range @col.
'@ws - Worksheet Object
'@col - String value, The Column Range value to be searched for Unique Values.
'Notes:
' - @col should ideally be a single column/row to have Values looked at for Cingularity.
Function UniqueValues(ws As Worksheet, col As String) As Variant
Dim rng As Range: Set rng = ws.Range(col)
Dim dict As New Scripting.Dictionary
If Not (rng Is Nothing) Then
Dim cell As Range, val As String
For Each cell In rng.Cells
val = CStr(cell.Value)
If Not dict.Exists(val) Then
dict.Add val, val
End If
Next cell
End If
'Return value
UniqueValues = dict.Items
End Function
Protections[]
- Enables access to the Worksheet, effectively turning the Protections off.
'Enables/Unprotects a Worksheet
'@ws - Worksheet Object
'Returns: XlEnableSelection value
'Notes:
' - Makes a Worksheet Editable/Unprotected to operate with.
' - Returns XlEnableSelection value for state retention for later lock-down.
Function EnableSelect(ws As Worksheet) As XlEnableSelection
Dim ret As XlEnableSelection
ret = ws.EnableSelection
ws.EnableSelection = xlNoRestrictions
EnableSelect = ret
End Function
- Disables access to the Worksheet, effectively turning Protections On
'Disables/Protects a Worksheet
'@ws - Worksheet Object
'@sel - XlEnableSelection value
'Notes:
' - @sel is the return value from "EnableSelect"
Sub DisableSelect(ws As Worksheet, sel As XlEnableSelection)
ws.EnableSelection = sel
End Sub
NamedRange[]
ListObject[]
- Takes a Range Name and returns the ListObject/Table it is contained in
'Get ListObject object from a Named Range
'Parameters:
'@wb - Workbook object, the workbook to get ListObject from
'@nm - String value, the name of the Named Range to obtain ListObject
'Return:
' - ListObject object, was able to backwards extract the ListObject associated with the Named Range
' - Nothing, there was not a ListObject associated with the Named Range.
Function GetListObject(wb As Workbook, nm As String) As ListObject
On Error Resume Next
Dim rng As range: Set rng = wb.Names(nm).RefersToRange
Dim valid As Boolean: valid = (rng.ListObject.name <> "")
On Error GoTo 0
If valid Then
Set GetListObject = rng.ListObject
Else
Set GetListObject = Nothing
End If
End Function
Get/Set Values[]
- Returns the Value in Column 2, or specified column, of the given NamedRange
- tbl
- String value, Range name to use. Can include Table Ranges, or just a simple non-defined Range with 2 or more columns.
- key
- Variant object/value, The key value within tbl to search for. Uses Column 1 of the multi-column range.
- col
- (Optional)Long value, the Column in tbl to return the value from. Defaults to the 2nd Column but can specify another Column index.
Function GetValue(tbl As String, key, Optional col As Long = 2)
Dim rng As Excel.Range, i As Long
Set rng = Range(tbl)
For i = 1 To rng.Rows.Count
If rng(i, 1).Value = key Then
GetValue = rng(i, col).Value
Exit Function
End If
Next
GetValue = Nothing
End Function
- Sets the Value in Column 2, or specified column, of the given NamedRange with the specified Key as a reference point.
Sub SetValue(tbl, key, val, Optional col As Long = 2)
Dim rng As Range, i As Long
Set rng = Range(tbl)
For i = 1 To rng.Rows.Count
If rng(i, 1).Value = key Then
rng(i, col).Value = val
End If
Next
End Sub
VLookup Replacement[]
- To help with using the VLookup Worksheet Function, without typing the Class Name (WorksheetFunction) and then the Method/Property (VLookup) every single time you need to utilize it in VBA.
'@rng - String value, Range or Table value
'@key - String value, The Value to lookup in @rng
'@col - Long value, The Column in @rng that contains the value to be returned
Function Lookup(rng As Range, key As Variant, Optional col As Long = 2)
Lookup = WorksheetFunction.VLookup(key, rng, col, True)
End Function
Hide Empty Rows[]
- Hides the EntireRow if the the sum of all Cells in the Row is zero (0). [2]
Sub HideEmptyRows(HideRange As Range)
Dim rcount As Long, r As Long
If HideRange Is Nothing Then Exit Sub
If HideRange.Areas.Count > 1 Then Exit Sub
With HideRange
rcount = .Rows.Count
For r = rcount To 1 Step -1
If .Rows(r).Hidden = False Then
If Application.CountA(.Rows(r)) = 0 Then
.Rows(r).EntireRow.Hidden = True
End If
End If
Next r
End With
End Sub
Empty Rows[]
- Empty the rows specified within the @rng parameter
- Also allows the use of Hide Empty Rows, to hide the rows that were just emptied.
'Empty all rows within a ListObject (Table)
'Parameters:
'@rng - Range object,
'@rstart - Long value, First row in the ListObject to start emptying row/col contents
'@ccol - Long value, The Control column to validate if it is empty before processing other columns
'@hide - Boolean value, Whether empty rows should be hidden
Sub EmptyRows(rng As Range, Optional rstart As Long = 1, Optional ccol As Long = 1, Optional hide As Boolean = False)
'If 'rng' object is null then prematurely exit sub
If rng Is Nothing Then Exit Sub
Dim rcount As Long, r As Long
With rng
rcount = .Rows.Count
For r = rstart To rcount
str = r & "/" & rcount
'Check if row is hidden or not
If .Rows(r).Hidden Then
'Unhide Row
.Rows(r).Hidden = False
End If
'Obtain value of the current cell, by the control column, for checking
Dim val As String: val = .Cells(r, ccol).Value
'Check if value is Null, after trimming all blank or empty spaces
If Not IsNull(Trim(val)) Then
'Check if the Row contains more than 0 cells with value
If Application.CountA(.Rows(r)) > 0 Then
.Rows(r).ClearContents 'Clear Contents of row
End If
End If
Next
End With
If hide Then
HideEmptyRows rng 'Hide excess rows from view
End If
End Sub
Delete Table Rows[]
First Column Index[]
- This method will Delete any Row in @rng assuming that the first column in @rng is Blank
'@rng - Range object
'@ccol - Long value
'Notes:
' - BLIND METHOD, Deletes Table Rows using @ccol as a validation column.
' * Any cell in @ccol that is Blank/Empty will constitue a deletion
' of the EntireRow, irregardless if there is Data in the other
' columns of the Row.
Sub DeleteTableRows(rng As Range, Optional ccol As Long = 1)
If rng Is Nothing Then Exit Sub
If rng.Areas.Count > 1 Then Exit Sub
If Application.CountA(rng.Columns(ccol)) = rng.Rows.Count Then Exit Sub
On Error Resume Next
rng.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
On Error GoTo 0
End Sub
N-th Column Index[]
- This method will Delete any Row in @rng assuming that the @ccol column in @rng is Blank [3]
Sub DeleteEmptyRows(rng As Range, Optional ccol As Long = 1)
If rng Is Nothing Then Exit Sub
If rng.Areas.Count > 1 Then Exit Sub
' Deletes all empty rows in Rng
' Processes Rows in a Backward approach
' Example: DeleteEmptyRows Selection
' Example: DeleteEmptyRows Range("A1:D100")
Dim col As Range: Set col = rng.Columns(ccol)
On Error Resume Next
col.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
On Error GoTo 0
End Sub
Evaluate[]
In Line[]
- This method will take the values in a specified Range and in-place Evaluate the results of a Formula in the Cells.[4]
Sub EvaluateRange(rng As String)
With Range(rng).CurrentRegion
.Cells.Copy
.Cells.PasteSpecial xlPasteValues
End With
Application.CutCopyMode = False
End Sub