McGimpsey & Associates

List the functions in a workbook

This macro will create a new worksheet in the ActiveWorkbook that lists the functions in each sheet, their location and their current value (see screenshot). Thanks to MVP Tom Ogilvy for the modification to add more sheets when the number of formulas exceeds the number of rows on a sheet!

I've written a separate routine to list the names in a workbook.

    Option Explicit

    Public Sub ListFormulasInWorkbook()
        ' by J.E. McGimpsey
        ' revised 04 July 2003 by Tom Ogilvy to add
        '   sheets when reaching ROWLIM formulas
        Const SHEETNAME As String = "Formulas in *"
        Const ALLFORMULAS As Integer = _
            xlNumbers + xlTextValues + xlLogical + xlErrors
        Const ROWLIM 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
            ' list 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 > ROWLIM 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 > ROWLIM 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 and create new one
            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

This page last updated 7/9/03

© Copyright 2001 - 2003 McGimpsey and Associates. Except where noted, all code on this site may be distributed under the Gnu GPL. Acknowledgement is appreciated.