Click here to Skip to main content
65,938 articles
CodeProject is changing. Read more.
Articles / VBA

Excel ToolBox

4.98/5 (13 votes)
27 Jul 2023CPOL5 min read 22.8K   722  
The Excel Tools I crafted to simplify my life as programmer
I have been programming Excel Sheets for years, and as I encountered problems, I created tools in VBA to help solve them.

Contents

  1. Introduction
  2. Scanning Macros
    1. Scanning Whole Sheet
    2. Starting From Active Cell
  3. Macros
    1. Search for #REF! in formulas
    2. Search for Orphans formulas
    3. Automating Plan
  4. Functions
    1. Extract()
    2. VLookUp with linear interpolation
    3. IndirectNV()
  5. Points of Interest
  6. History

Introduction

I work daily on huge Excel spreadsheets, 50K formulas in a WorkBook is common.

Over the years, I crafted functions and macros to simplify my Excel formulae and usage.

I am using VBA to be even compatible with Excel 2003 because I started Excel programming at that time, 20 years ago.

My Standard WS Settings

  • Only cells for user input are unlocked, all others are locked.
  • The WS is protected, so that user can't delete formulas by mistake.

This ensures minimum security in sheets. For more security, sheets are password protected.

Samples.xls

The file Samples.xls in Downloads file show sample usage of following pieces of code.

Formula()

This tiny function has no other purpose than to display the formula of another cell.

It is just a helper for screenshots on Excel.

VB
' 20230717 Patrice_T
Function Formula(Adrs As Range) As String
    Formula = Adrs.Formula
End Function

Formula.bas in ExcelToolBox.zip.

Scanning Macros

Mainly for checking purposes, I created macros that scans WorkSheets. There are two kinds of macros, some are scanning whole WorkSheets, others start at active cell.

Scanning Whole Sheet

Sometimes, I want the macros to scan the whole WorkSheet because some problems need mandatory fixes.

Those macros use this skeleton.

VB
For Each Cel In ActiveSheet.UsedRange
	' Do stuf or Checks
	' Set Condition
    If Condition Then
        Cel.Activate
        MsgBox "Error at Cell " & Replace(ActiveCell.Address, "$", "")
        Exit Sub
    End If
Next

Macros scan every Cell in Sheet checking for a condition and stop when encountered.

Starting From Active Cell

Sometimes, I want the macro to start scanning at active cell because some conditions are not always problems to fix.

Those macros use this skeleton.

VB.NET
Dim RowS As Long
Dim RO, CO
RowS = ActiveSheet.UsedRange.RowS.Count
RO = ActiveCell.Row
CO = ActiveCell.Column
Rupt = ActiveCell.Value

For Scan = RO To RowS
   	' Do stuf or Checks
   	' Set Condition
    If Condition Then
        ActiveSheet.Cells(Scan, CO).Activate
        Exit Sub
    End If
Next

This code scans in a column for a condition starting at Active Cell.

Macros

Macros are programs that are run from Menu or Ribbons (GUI).

Search for #REF! in Formulas

Any formula containing a #REF! is in error because the Cell initially referred to has been deleted. This happens sometimes when deleting parts of a Sheet. Any of such error must be corrected, so full Sheet scan.

Excel provides such a tool, but one has to select the offending cell to see if there is such problem in the cell. Not really pleasing when one has to check 50K cells. Otherwise, one has to use the Excel error locating feature, but in my case, I have added other checks specific to the sheet I am working on.

Image 1

VB
' 20220201 Patrice T
Sub ScanRef()
    ' TP recherche de #ref! dans la feuille
    For Each Cel In ActiveSheet.UsedRange
        If InStr(Cel.Formula, "#REF!") > 0 Then
            Cel.Activate
            MsgBox "Erreur Cellule " & Replace(ActiveCell.Address, "$", "") _
                    & vbLf & " Erreur #REF! dans formule (formule cassée)"
            Exit Sub
        End If
    Next

End Sub

ScanRef.bas in ExcelToolBox.zip.

Search for Orphans Formulas

Orphan Formulas are formulas referring to empty cells. It is potentially a problem, but not always. The macro scans from active cell.

Image 2

This screenshot has the #REF! error and the formula is also orphan because it refers to C2 which is empty.

Excel can highlight such formulas, but my macro can also allow referring to empty cells if they are in specific ranges. Example: in a list of operations on bank account with deposit and withdraw columns, the continuous balance will refer to empty cells, and it is normal.

The RegEx

In this RegEx, I want to match only Cell references, Ranges and defined names. But as formulas are complicated, I have found it easier to match unwanted parts to prevent false matches. What is matched as unwanted match will not make a false match.

  • Unwanted: match strings
  • Wanted: match optional WS name and Cell adress of Range
  • Unwanted: match functions names
  • Wanted: match defined names
VB
Dim xRegEx As Object
Set xRegEx = CreateObject("VBSCRIPT.REGEXP")
'   The RegEx
'   Match a string
'   (""[^""]*"")
'   match sheet name without space
'   ([a-zA-Zé0-9_]+!)
'   match sheet name with space
'   ('[a-zA-Zé0-9\s_]+'!)
'   match cell adress or range
'   \$?[A-Z]{1,3}\$?[0-9]{1,7}(:\$?[A-Z]{1,3}\$?[0-9]{1,7})?
'   match a function name
'   ([a-zA-Zé0-9\._]+\()
'   match defined name
'   ([a-zA-Zé_][a-zA-Zé0-9_]+)
With xRegEx
    .Pattern = "(""[^""]*"")|(([a-zA-Zé0-9_]+!)|('[a-zA-Zé0-9\s_]+'!))_
    ?\$?[A-Z]{1,3}\$?[0-9]{1,7}(:\$?[A-Z]{1,3}\$?[0-9]{1,7})?|_
    ([a-zA-Zé0-9\._]+\()|([a-zA-Zé_][a-zA-Zé0-9_]+)"
    .Global = True
    .MultiLine = True
    .IgnoreCase = False
End With

Orphan.bas in ExcelToolBox.zip.

Define Ranges where orphans are allowed

VB
'   List of ranges where orphans are allowed
'    List = Array("F1:H20")
List = Array()

Orphan.bas in ExcelToolBox.zip.

Code is sorting out what matches are.

VB
If Cel.HasFormula Then
    ' c'est bien une formule
    Set Tmp = xRegEx.Execute(Cel.Formula)
    For i = 0 To Tmp.Count - 1
        If Left(Tmp.Item(i), 1) = """" Then
            ' ne pas traiter les chaines de caractères
        ElseIf InStr(Tmp.Item(i), "(") <> 0 Then
            ' nom de fonction, sauter
        ElseIf InStr(Tmp.Item(i), "TRUE") <> 0 Then
            ' sauter
        ElseIf InStr(Tmp.Item(i), "FALSE") <> 0 Then
            ' sauter
        Else
            ' si Cel dans ranges de list, alors sauter la vérification
            ' Vérifier la formule
            Set Target = Range(Tmp.Item(i).Value)
            Verif = True
            If ActiveSheet.Name <> Target.Worksheet.Name Then
                ' WS différent, sauter
            Else
                For Each Ligne In List
                    If Not Application.Intersect(Range(Ligne), Target) _
                        Is Nothing Then
                        Verif = False
                    End If
                Next
            End If
            If Verif Then
                If Target.Rows.Count = 1 And Target.Columns.Count = 1 Then
                    If Target.Formula = "" And Target.Locked Then
                        Cel.Activate
                        ' MsgBox "Cellule " & Replace(Cel.Address, _
                        ' "$", "") & "fait référence à une cellule vide" & _
                        ' vbLf & Replace(Ref.Address, "$", ""), vbYesNoCancel

                        Exit Sub
                    End If
                End If
            End If
        End If
    Next
End If

Orphan.bas in ExcelToolBox.zip.

Automating Plan

Since the WS is huge, I use Plan to hide/fold parts to ease navigation. The macro manages the plan creation.

A column is reserved to indicate which rows are headers or details. (See Samples.xls.)

Delete Existing Plan

VB
' nettoyer plan
ActiveSheet.UsedRange.ClearOutline

Plan.bas and see Plan.xls in ExcelToolBox.zip.

Settings for New Plan

VB
' options plan
With ActiveSheet.Outline
    .AutomaticStyles = False
    .SummaryRow = xlAbove
    .SummaryColumn = xlRight
End With

Plan.bas and see Plan.xls in ExcelToolBox.zip.

Locate the column holding Plan information on second row

VB
' recherche colonne 'Plan'
Ligne = 2
For Col = 1 To ActiveSheet.Columns.Count
    If ActiveSheet.Cells(Ligne, Col).Text = "Plan" Then
        Exit For
    End If
Next

Plan.bas and see Plan.xls in ExcelToolBox.zip.

Locate first Plan information in column

VB
If ActiveSheet.Cells(Ligne, Col).Text = "Plan" Then
    ' chercher début premier bloc
    For Row = Ligne + 1 To ActiveSheet.Rows.Count
        If ActiveSheet.Cells(Row, Col).Value = 1 Then
            Exit For
        End If
    Next

Plan.bas and see Plan.xls in ExcelToolBox.zip.

Create groups

Cells containing 1s are group headers, Cells containing 2s are group body.

VB
' groupes
Row_db = Row
While Row_db < ActiveSheet.Rows.Count And ActiveSheet.Cells(Row_db, Col).Value > 0
    ' chercher fin bloc
    row_fn = Row_db + 1
    While row_fn <= ActiveSheet.Rows.Count And ActiveSheet.Cells(row_fn, Col).Value = 2
        row_fn = row_fn + 1
    Wend
    If row_fn > Row_db + 1 Then
        ' grouper bloc
        ActiveSheet.Range(Cells(Row_db + 1, 1), Cells(row_fn - 1, 1)).Rows.Group
    End If
    Row_db = row_fn
Wend

Plan.bas and see Plan.xls in ExcelToolBox.zip.

Functions

Functions are used in cells formulas.

Extract()

My users are using dimensions of metal sheets and beams in millimetres. Dimensions are width * thickness * length, aka 200*10*550.

My problem is that I need to get the three numbers for the computations, and there is no standard simple solution in Excel, one has to butcher the input directly in formula.

My solution is to have a specialized function that does the job.

Image 3

VB
'   Author: Patrice T
' Extracts numbers from the string
Function Extract(Chaine, Optional Pos = 1)
    If IsNumeric(Chaine) Then
        ' c'est numerique, on retourne la valeur
        Extract = Chaine
        Exit Function
    End If
    ' Set re = CreateObject("VBScript.RegExp")
    Set re = New VBScript_RegExp_55.RegExp
    re.Global = True
    re.Pattern = "[0-9,.]+"
    Set A = re.Execute(Chaine)
    If A.Count >= Pos Then
        Extract = Val(Replace(A(Pos - 1), ",", "."))
    End If

End Function

Extract.bas and see Plan.xls in ExcelToolBox.zip.

VLookUp with Linear Interpolation

I have numerous tables where some rows are missing. Rather than completing every single table with missing rows, it was easier to create a function that locates the two closest values around the searched value and then does linear interpolation between them to get the missing value.

Image 4

VB
' VLookUp with linear interpolation
' 2015/04/01 Patrice T
Function VLookUpLI(Valeur, tableau, colon, dummy)
    Dim Scan
    Dim val_pref, val_suff, val_min, val_max, res_min, res_max
    Dim tmp_pref, tmp_suff

    If InStr(Valeur, "*") = 0 Then
        val_pref = Val(Valeur)
        val_suff = ""
    Else
        val_pref = Val(Left(Valeur, InStr(Valeur, "*") - 1))
        val_suff = Mid(Valeur, InStr(Valeur, "*"))
    End If
    For Scan = 1 To tableau.Rows.Count
        Tmp = tableau.Cells(Scan, 1).Value
        If VarType(Tmp) = VarType(Valeur) Then
            If Tmp = Valeur Then
                ' la valeur existe
                VLookUpLI = tableau.Cells(Scan, colon).Value
                Exit Function
            End If
            If InStr(Tmp, "*") = 0 Then
                tmp_pref = Val(Tmp)
                tmp_suff = ""
            Else
                tmp_pref = Val(Left(Tmp, InStr(Tmp, "*") - 1))
                tmp_suff = Mid(Tmp, InStr(Tmp, "*"))
            End If
            If tmp_pref < val_pref And tmp_suff = val_suff Then
                If IsEmpty(val_min) Then
                    val_min = tmp_pref
                    res_min = tableau.Cells(Scan, colon).Value
                ElseIf val_min < tmp_pref Then
                    val_min = tmp_pref
                    res_min = tableau.Cells(Scan, colon).Value
                End If
            End If
            If tmp_pref > val_pref And tmp_suff = val_suff Then
                If IsEmpty(val_max) Then
                    val_max = tmp_pref
                    res_max = tableau.Cells(Scan, colon).Value
                ElseIf tmp_pref < tmp_max Then
                    val_max = tmp_pref
                    res_max = tableau.Cells(Scan, colon).Value
                End If
            End If
        End If
    Next
    If IsEmpty(val_min) Or IsEmpty(val_max) Then
        ' valeur hors tableau
        VLookUpLI = "Hors limites"
    Else
        '   interpolation linéaire
        VLookUpLI = res_min + (res_max - res_min) * 
                    (val_pref - val_min) / (val_max - val_min)
    End If

End Function

VLookU in ExcelToolBox.zip.

IndirectNV()

The native Indirect function is volatile because Excel has no idea if cells targeted by Indirect parameter have changed or not. So the only solution for Excel is to force the evaluation every time the sheet is recalculated, this is the meaning of volatile.

I created the Non Volatile Indirect function because in my usage, I know that the cells targeted are constant.

Usage is identical to native Indirect function.

VB
' 20230526 Non Volatile Indirect
' Accelerate the usage of Indirect because the target is considered as constant
Function IndirectNV(Chaine As String) As Range
    Set IndirectNV = Range(Chaine)
End Function

Indirect.bas in ExcelToolBox.zip.

Points of Interest

Those tools are easing my life as Excel sheets designer.

History

  • 15th July, 2023: First draft
  • 19th July, 2023: Few corrections and Download update
  • 27th July, 2023: Improved explanations

License

This article, along with any associated source code and files, is licensed under The Code Project Open License (CPOL)