Auto-generating a list of all formulas in an Excel file

Here's a handy macro to make a new work­sheet inside your Excel file, then tra­verse through each and every sheet in the file, col­lect­ing all func­tions and for­mu­las used in the whole file. All these for­mu­las are listed on a sep­a­rate work­sheet in the same file.

Here's a handy macro to make a new work­sheet inside your Excel file, then tra­verse through each and every sheet in the file, col­lect­ing all func­tions and for­mu­las used in the whole file. All these for­mu­las are listed on a sep­a­rate work­sheet in the same file.

The code is below, feel free to use it but please attribute when­ever you use it, thanks –

Option Explicit
Public Sub ListFormulasInWorkbook()
Const SHEETNAME As String = "Formulas in *"
Have fun!
Const ALLFORMULAS As Integer = _
xlNumbers + xlTextValues + xlLogical + xlErrors
Const maxRows As Long = 65500
Dim formulaSht As Worksheet
Dim destRng As Range
Dim cell As Range
Dim wkSht As Worksheet
Dim formulaRng As Range
Dim shCnt As Long
Dim oldScreenUpdating As Boolean
With Application
oldScreenUpdating = .ScreenUpdating
.ScreenUpdating = False
End With
shCnt = 0
ListFormulasAddSheet formulaSht, shCnt
' Enumerate formulas on each sheet
Set destRng = formulaSht.Range("A4")
For Each wkSht In ActiveWorkbook.Worksheets
If Not wkSht.Name Like SHEETNAME Then
Application.StatusBar = wkSht.Name
destRng.Value = wkSht.Name
Set destRng = destRng.Offset(1, 0)
On Error Resume Next
Set formulaRng = wkSht.Cells.SpecialCells( _
xlCellTypeFormulas, ALLFORMULAS)
On Error GoTo 0
If formulaRng Is Nothing Then
destRng.Offset(0, 1).Value = "None"
Set destRng = destRng.Offset(1, 0)
Else
For Each cell In formulaRng
With destRng
.Offset(0, 1) = cell.Address(0, 0)
.Offset(0, 2) = "'" & cell.Formula
.Offset(0, 3) = cell.Value
End With
Set destRng = destRng.Offset(1, 0)
If destRng.row > maxRows Then
ListFormulasAddSheet formulaSht, shCnt
Set destRng = formulaSht.Range("A5")
destRng.Offset(-1, 0).Value = wkSht.Name
End If
Next cell
Set formulaRng = Nothing
End If
With destRng.Resize(1, 4).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 5
End With
Set destRng = destRng.Offset(1, 0)
If destRng.row > maxRows Then
ListFormulasAddSheet formulaSht, shCnt
Set destRng = formulaSht.Range("A5")
destRng.Offset(-1, 0).Value = wkSht.Name
End If
End If
Next wkSht
With Application
.StatusBar = False
.ScreenUpdating = oldScreenUpdating
End With
End Sub
Private Sub ListFormulasAddSheet( _
formulaSht As Worksheet, shtCnt As Long)
Const SHEETNAME As String = "Formulas in "
Const SHEETTITLE As String = "Formulas in $ as of "
Const DATEFORMAT As String = "dd MMM yyyy hh:mm"
Dim shtName As String
With ActiveWorkbook
' Delete existing sheet, create new
shtCnt = shtCnt + 1
shtName = Left(SHEETNAME & .Name, 28)
If shtCnt > 1 Then _
shtName = shtName & "_" & shtCnt
On Error Resume Next
Application.DisplayAlerts = False
.Worksheets(shtName).Delete
Application.DisplayAlerts = True
On Error GoTo 0
Set formulaSht = .Worksheets.Add( _
after:=Sheets(Sheets.Count))
End With
With formulaSht
' Format headers
.Name = shtName
.Columns(1).ColumnWidth = 15
.Columns(2).ColumnWidth = 8
.Columns(3).ColumnWidth = 60
.Columns(4).ColumnWidth = 40
With .Range("C:D")
.Font.Size = 9
.HorizontalAlignment = xlLeft
.EntireColumn.WrapText = True
End With
With .Range("A1")
.Value = Application.Substitute(SHEETTITLE, "$", _
ActiveWorkbook.Name) & Format(Now, DATEFORMAT)
With .Font
.Bold = True
.ColorIndex = 5
.Size = 14
End With
End With
With .Range("A3").Resize(1, 4)
.Value = Array("Sheet", "Address", "Formula", "Value")
With .Font
.ColorIndex = 13
.Bold = True
.Size = 12
End With
.HorizontalAlignment = xlCenter
With .Borders(xlEdgeBottom)
.LineStyle = xlDouble
.Weight = xlThick
.ColorIndex = 5
End With
End With
End With
End Sub

Have fun!