McGimpsey & Associates

List the names in a workbook

XL MVP Jan Karel Pieterse has written a fabulous utility add-in, "Name Manager.xla" to manage (including printing out) names. The add-in works with both Mac and Windows XL versions. I've seen nothing better.

If you don't want to use an add-in, the macro below will create a new worksheet in the ActiveWorkbook that lists the names in the Workbook and the names in each sheet, and what they refer to (see screenshot). This uses the .ListNames method to paste workbook level only names into a new sheet, followed by sheet-level names (.ListNames only lists those names that are in scope - so worksheet-level names on a different sheet won't be listed).

I've written a separate routine to list the formulas/functions in a workbook.

    Option Explicit

    Public Sub ListNamesInWorkbook()
        ' by J.E. McGimpsey
        ' Thanks to Tom Ogilvy for help with overflow.
        Const SHEETNAME As String = "Names in *"
        Const ROWLIM As Long = 65500
        Dim nameSht As Worksheet
        Dim destRng As Range
        Dim cell As Range
        Dim wkSht As Worksheet
        Dim shCnt As Long
        Dim i As Long
        Dim oldScreenUpdating As Boolean
        
        With Application
            oldScreenUpdating = .ScreenUpdating
            .ScreenUpdating = False
        End With
        shCnt = 0
        ListNamesAddSheet nameSht, shCnt
        ' list Workbook-level names
        Set destRng = nameSht.Range("A5")
        With destRng.Offset(-1, 0)
            .Value = "Workbook-Level names"
            .Font.Bold = True
        End With
        With ActiveWorkbook.Names
            If .Count Then
                destRng.Offset(0, 1).ListNames  'only workbook level
                Set destRng = destRng.Offset(0, 1).End(xlDown).Offset(1, -1)
            Else
                destRng.Offset(0, 1).Value = "None"
                Set destRng = destRng.Offset(0, 1)
            End If
        End With
        With destRng.Resize(1, 3).Borders(xlEdgeBottom)
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = 5
        End With
        Set destRng = destRng.Offset(1, 0)
        For Each wkSht In ActiveWorkbook.Worksheets
            With destRng
                .Value = "Names in sheet """ & wkSht.Name & """"
                .Font.Bold = True
                Set destRng = .Offset(1, 0)
            End With
            With wkSht.Names
                If .Count Then
                    For i = 1 To .Count
                        With .Item(i)
                            destRng.Offset(0, 1) = Mid(.Name, InStr(.Name, "!") + 1)
                            destRng.Offset(0, 2) = "'" & .RefersTo
                            Set destRng = destRng.Offset(1, 0)
                            If destRng.row > ROWLIM Then
                                ListNamesAddSheet nameSht, shCnt
                                Set destRng = nameSht.Range("A5")
                                destRng.Offset(-1, 0).Value = _
                                    "Names in sheet """ & wkSht.Name & """"
                            End If
                        End With
                    Next i
                Else
                    destRng.Offset(0, 1).Value = "None"
                    Set destRng = destRng.Offset(1, 0)
                End If
            End With
            With destRng.Resize(1, 4).Borders(xlEdgeBottom)
                .LineStyle = xlContinuous
                .Weight = xlThin
                .ColorIndex = 5
            End With
            Set destRng = destRng.Offset(1, 0)
        Next wkSht
        With Application
            .StatusBar = False
            .ScreenUpdating = oldScreenUpdating
        End With
    End Sub

    Private Sub ListNamesAddSheet( _
                nameSht As Worksheet, shtCnt As Long)
        Const SHEETNAME As String = "Names in "
        Const SHEETTITLE As String = "Names 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
            shtName = Left(SHEETNAME & .Name, 28)
            shtCnt = shtCnt + 1
            If shtCnt > 1 Then _
                shtName = shtName & "_" & Format(shtCnt, "00")
             On Error Resume Next
            Application.DisplayAlerts = False
            .Worksheets(shtName).Delete
            Application.DisplayAlerts = True
            On Error GoTo 0
            Set nameSht = .Worksheets.Add( _
                    after:=Sheets(Sheets.Count))
        End With

       With nameSht
            ' Format headers
            .Name = shtName
            .Columns(1).ColumnWidth = 30
            .Columns(2).ColumnWidth = 20
            .Columns(3).ColumnWidth = 90
            With .Range("B:C")
                .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, 3)
                .Value = Array("Sheet", "Name", "Refers To")
                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.