Option Explicit

Public Sub ListFormulasInWorkbook()

Const SHEETNAME As String = “Formulas in *”
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