VBA Express : Excel - BUGFIX: List all formulas in a workbook on a separate worksheet

Excel

BUGFIX: List all formulas in a workbook on a separate worksheet

Ease of Use

Intermediate

Version tested with

Submitted by:

campbeln

Description:

This is a simple code-fix for the code at http://www.vbaexpress.com/kb/getarticle.php?kb_id=409 so that proper sheets are listed against formulas. The 4 BugFix lines are marked in the code below. This code creates a list all formulas in a workbook. A new worksheet is added and the formulas, including the sheet name and cell address, are listed in Columns A, B and C.

Discussion:

It can be difficult to keep track of all the formulas within a large workbook. This code will create a list of all the formulas, along with the sheet name and cell address. This can be useful if someone needs to review the formulas used or if you just need to find one particular formula or a set of formulas. A new worksheet is created, named by the user via an Input Box, and headings added. The new sheet is then excluded from the loop. UsedRange and SpecialCells are used to reduce the need to search every cell on each sheet. Once a cell with a formula is found, the code removes the equals sign (=) from the formula to allow the details to be placed in the new sheet without a calculation taking place. The sheet name and cell address are then added as well.

Code:

instructions for use

			Option Explicit 
 
 'http://www.vbaexpress.com/kb/getarticle.php?kb_id=409
Sub ListAllFormulas() 
     
    Dim sht As Worksheet 
    Dim shtName 
    Dim myRng As Range 
    Dim newRng As Range 
    Dim c As Range 
     
ReTry: 
    shtName = Application.InputBox("Choose a name for the new sheet to list all formulas.", "New Sheet Name", "_AllFormulas") 'the user decides the new sheet name
    If shtName = False Then Exit Sub 'exit if user clicks Cancel
     
    On Error Resume Next 
    Set sht = Sheets(shtName) 'check if the sheet exists
    If Not sht Is Nothing Then 'if so, send message and return to input box
        MsgBox "This sheet already exists" 
        Err.Clear 'clear error
        Set sht = Nothing 'reset sht for next test
        GoTo ReTry 'loop to input box
    End If 
     
    Worksheets.Add.Move after:=Worksheets(Worksheets.Count) 'adds a new sheet at the end
    Application.ScreenUpdating = False 
    With ActiveSheet 'the new sheet is automatically the activesheet
        .Range("A1").Value = "Formula" 'puts a heading in cell A1
        .Range("B1").Value = "Sheet Name" 'puts a heading in cell B1
        .Range("C1").Value = "Cell Address" 'puts a heading in cell C1
        .Name = shtName 'names the new sheet from InputBox
    End With 
     
    For Each sht In ActiveWorkbook.Worksheets 'loop through the sheets in the workbook
        If sht.Name <> shtName Then 'exclude the sheet just created
            Set myRng = sht.UsedRange 'limit the search to the UsedRange
            On Error Resume Next 'in case there are no formulas
            Set newRng = myRng.SpecialCells(xlCellTypeFormulas) 'use SpecialCells to reduce looping further
            For Each c In newRng 'loop through the SpecialCells only
                If (Not c Is Nothing) Then '## <BugFix>
                    If (Len(c.Formula) > 1) Then '## <BugFix>
                         'places the formula minus the '=' sign in column A
                        Sheets(shtName).Range("A65536").End(xlUp).Offset(1, 0).Value = VBA.Strings.Mid(c.Formula, 2, (Len(c.Formula))) 
                         'places the sheet name containing the formula in column B
                        Sheets(shtName).Range("B65536").End(xlUp).Offset(1, 0).Value = sht.Name 
                         'places the cell address, minus the "$" signs, containing the formula in column C
                        Sheets(shtName).Range("C65536").End(xlUp).Offset(1, 0).Value = Application.WorksheetFunction.Substitute(c.Address, "$", "") 
                    End If '## </BugFix>
                End If '## </BugFix>
            Next c 
        End If 
    Next sht 
    Sheets(shtName).Activate 'make the new sheet the activesheet
    ActiveSheet.Columns("A:C").AutoFit 'autofit the data
    Application.ScreenUpdating = True 
End Sub

How to use:

Press Alt+F11 from Excel to open the VB Editor.
Click on the Project(Workbook) name in the left pane.
Click on ?Insert? on the Menu Bar
Select ?Module? from the list. The new Module will open.
Paste the code into the right pane of the Module.
Click on Alt+F11 to return to Excel

Test the code:

Can be run in any workbook or from your Personal.xls file.
Press Alt+F8 and select the macro name from the list or from the menu bar, click
Tools > Macro > Macros and select the macro name from the list.
Or create a button and add the code to the button.

Sample File:

No Attachment

Approved by Jacob Hilderbrand

This entry has been viewed 250 times.