Microsoft Wiki

Be sure to join our wiki's Discord server by clicking here
Also follow our wiki's Twitter by clicking here

READ MORE

Microsoft Wiki
Register
Advertisement

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.

Blind Code

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

Blind Code

'@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]

Blind Code

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]

Blind Code

Sub EvaluateRange(rng As String)
   With Range(rng).CurrentRegion
      .Cells.Copy
      .Cells.PasteSpecial xlPasteValues
   End With
   Application.CutCopyMode = False
End Sub


References[]

Advertisement