Find where named ranges are being used in big workbook

Question

I have a list of 594 named ranges in a workbook with nearly 20 sheets, each sheet has about 200 columns of data. I need to find out where the named ranges are being used so as to remove irrelevant ones. I pasted a list of named ranges onto the sheet and then I tried to find if they were used in a formula by recording them, and then using the find method in all sheets and columns. The problem is despite using lookin xlformulas, it retrieves the named range even if it is just a text.

Here is my (updated) attempt (if it is not evident already, i am an amateur):

Application.ScreenUpdating = False

Count = ActiveWorkbook.Sheets.Count

Sheets(Count).Activate

Dim locr(1 To 595)
Dim locc(1 To 595)
Dim locn(1 To 595)
Dim nam(1 To 595)

Dim rng As Range

Range("a1").Select

    For X = 1 To 595 'populate array with named ranges
        ActiveCell.Offset(1, 0).Select
        nam(X) = ActiveCell.Value
    Next X


            For i = 1 To 595 'name loop


                For j = 1 To (Count - 1) 'sheet loop


                    Sheets(j).Activate
                    On Error Resume Next
                    Set orange = Sheets(j).Cells.SpecialCells(xlCellTypeFormulas) 'limit range to cells that only contain formulas

                    On Error GoTo 20 'if no formulas in sheet, go to next sheet

                        If Not orange Is Nothing Then
                            Set rng = orange.Find(What:=nam(i), _
                                             LookIn:=xlFormulas, _
                                             LookAt:=xlPart, _
                                             SearchOrder:=xlByRows, _
                                             SearchDirection:=xlNext, _
                                             MatchCase:=False) 'find named range

                                If Not rng Is Nothing Then 'if named range found

                                    Application.Goto rng, True 'go to cell where name range found and record address

                                    locr(i) = ActiveCell.Row
                                    locc(i) = ActiveCell.Column
                                    locn(i) = ActiveSheet.Name

                                GoTo 10 'value found, go to next sheet

                                Else

                                End If

                        Else
                        End If


20              Next j

            locr(i) = "" 'record empty since "rng" is empty
            locr(i) = ""
            locr(i) = ""

10          Next i

Sheets(Count).Activate
Range("c1").Select
b = 1

    For a = 1 To 595 'populate addresses of named ranges


    ActiveCell.Offset(b, 2).Value = locr(a)
    ActiveCell.Offset(b, 1).Value = locc(a)
    ActiveCell.Offset(b, 0).Value = locn(a)
    b = b + 1

    Next a

Frangible

+ 1 Amazing question. had me thinking for a long time :) – Cavie

@SiddharthRout, me too! – Romaineromains

Answer 1

Here is one way I can think of. I will explain this in 2 parts.

PART 1

Let's say we have a named range Sid.

This word Sid can appear in any one of these forms as shown in the image below. Why does it start with =? That has been explained in Part2 below.

=Sid    '<~~ 1
="Sid"  '<~~ 2
=XSid   '<~~ 3
=SidX   '<~~ 4
=_Sid   '<~~ 5
=Sid_   '<~~ 6
=(Sid)  '<~~ 7

Any other scenarios, I guess will be a subset of the above. Now out of these the only valid find in our case is the first one and the last one since we are looking for our named range.

So here is a quick function to check if the cell formula has a named range or not. I am sure it can be made more efficient

Function isNamedRangePresent(rng As Range, s As String) As Boolean
    Dim sFormula As String
    Dim pos1 As Long, pos2 As Long, sLen As Long, i As Long

    sFormula = rng.Formula: sLen = Len(sFormula)

    pos2 = 1

    Do
        pos1 = InStr(pos2, sFormula, s) - 1
        If pos1 < 1 Then Exit Do

        isNamedRangePresent = True

        For i = 65 To 90
            '~~> A-Z before Sid for example XSid
            If UCase(Mid(sFormula, pos1, 1)) = Chr(i) Then
                isNamedRangePresent = False
                Exit For
            End If
        Next i

        '~~> Check for " for example "Sid
        If isNamedRangePresent = True Then _
        If UCase(Mid(sFormula, pos1, 1)) = Chr(34) Then isNamedRangePresent = False
        '~~> Check for underscore for example _Sid
        If isNamedRangePresent = True Then _
        If UCase(Mid(sFormula, pos1, 1)) = Chr(95) Then isNamedRangePresent = False

        pos2 = pos1 + Len(s) + 1

        If pos2 <= sLen Then
            For i = 65 To 90
                '~~> A-Z after Sid for example SidX
                If UCase(Mid(sFormula, pos2, 1)) = Chr(i) Then
                    isNamedRangePresent = False
                    Exit For
                End If
            Next i

            '~~> "Sid
            If isNamedRangePresent = True Then _
            If UCase(Mid(sFormula, pos2, 1)) = Chr(34) Then isNamedRangePresent = False
            '~~> _Sid
            If isNamedRangePresent = True Then _
            If UCase(Mid(sFormula, pos2, 1)) = Chr(95) Then isNamedRangePresent = False
        End If
    Loop
End Function

So in the first and the last case, Debug.Print isNamedRangePresent(Range("D2"), "Sid") will give you True See this

PART 2

Now coming to the .Find. I see that you are searching only once in the worksheet. Since you can have many scenarios of the word Sid being present, you cannot just have one .Find. You will have to use .FindNext. See THIS link on how to use that. I have explained it there so I won't bother explaining that here.

We can make our .Find more efficient by searching only those cells which has formulas. To do that we have to use .SpecialCells(xlCellTypeFormulas). This explains why we had "=" in our example in PART1. :)

Here is an example (PART1 Code added at the bottom)

Sub Sample()
    Dim oRange As Range, aCell As Range, bCell As Range
    Dim oSht As Worksheet
    Dim strSearch As String, FoundAt As String

    Set oSht = Worksheets("Sheet1")

    '~~> Set your range where you need to find - Only Formula Cells
    On Error Resume Next
    Set oRange = oSht.Cells.SpecialCells(xlCellTypeFormulas)
    On Error GoTo 0

    If Not oRange Is Nothing Then
        strSearch = "Sid"

        Set aCell = oRange.Find(What:=strSearch, LookIn:=xlFormulas, _
                    LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                    MatchCase:=False, SearchFormat:=False)

        If Not aCell Is Nothing Then
            Set bCell = aCell

            '~~> Check if the cell has named range
            If isNamedRangePresent(aCell, strSearch) Then FoundAt = aCell.Address

            Do
                Set aCell = oRange.FindNext(After:=aCell)

                If Not aCell Is Nothing Then
                    If aCell.Address = bCell.Address Then Exit Do

                    '~~> Check if the cell has named range
                    If isNamedRangePresent(aCell, strSearch) Then FoundAt = FoundAt & ", " & aCell.Address
                Else
                    Exit Do
                End If
            Loop
        Else
            MsgBox SearchString & " not Found"
            Exit Sub
        End If

        If FoundAt = "" Then
            MsgBox "The Named Range was not found"
        Else
            MsgBox "The Named Range has been found these locations: " & FoundAt
        End If
    End If
End Sub

Function isNamedRangePresent(rng As Range, s As String) As Boolean
    Dim sFormula As String
    Dim pos1 As Long, pos2 As Long, sLen As Long, i As Long

    sFormula = rng.Formula: sLen = Len(sFormula)

    pos2 = 1

    Do
        pos1 = InStr(pos2, sFormula, s) - 1
        If pos1 < 1 Then Exit Do

        isNamedRangePresent = True

        For i = 65 To 90
            '~~> A-Z before Sid for example XSid
            If UCase(Mid(sFormula, pos1, 1)) = Chr(i) Then
                isNamedRangePresent = False
                Exit For
            End If
        Next i

        '~~> Check for " for example "Sid
        If isNamedRangePresent = True Then _
        If UCase(Mid(sFormula, pos1, 1)) = Chr(34) Then isNamedRangePresent = False
        '~~> Check for underscore for example _Sid
        If isNamedRangePresent = True Then _
        If UCase(Mid(sFormula, pos1, 1)) = Chr(95) Then isNamedRangePresent = False

        pos2 = pos1 + Len(s) + 1

        If pos2 <= sLen Then
            For i = 65 To 90
                '~~> A-Z after Sid for example SidX
                If UCase(Mid(sFormula, pos2, 1)) = Chr(i) Then
                    isNamedRangePresent = False
                    Exit For
                End If
            Next i

            '~~> "Sid
            If isNamedRangePresent = True Then _
            If UCase(Mid(sFormula, pos2, 1)) = Chr(34) Then isNamedRangePresent = False
            '~~> _Sid
            If isNamedRangePresent = True Then _
            If UCase(Mid(sFormula, pos2, 1)) = Chr(95) Then isNamedRangePresent = False
        End If
    Loop
End Function

Output

PHEW!!!

Cavie

thanks for your effort... im having trouble using special cells, i get an error: no cells were found. here is my addition: On Error Resume Next Set orange = Sheets(j).Cells.SpecialCells(xlCellTypeFormulas) On Error GoTo 20 – Frangible

see how I have used it... If Not oRange Is Nothing Then – Cavie

thanks for your response.. i had included if not oRange is nothing but it seems to only work when i activate each sheet prior to setting the oRange? – Frangible

Can you update the question with the exact code that you are using? – Cavie

Hi, just updated the code, let me know your thoughts. It seems to work although it is pretty slow. – Frangible

I also exit the loop once the named range is found as that is enough evidence that it should not be removed.. – Frangible

Brilliant workthrough, thanks @SiddharthRout. I've got exactly this job to do and I'm always grateful when someone has already done the heavy lifting for me! One thing... unless I'm mistaken, there is a case I think your method doesn't account for: names suffixed with numerals. If the workbook contains named ranges like e.g. 'MyName', 'MyName1', 'MyName2', I think is something you'd need to test for to avoid incorrectly identifying 'MyName1' or 'MyName2' as 'MyName'. – Nausea

Answer 2

This code creates a copy of the workbook with the names. It then goes through and deletes each name in your list of names from the that copied workbook. It counts up the number of formula errors in the workbook before and after. If the error count is the same, the name wasn't used. If it's different, the name was used.

I like to do this kind of test for really complicated situations like this. It means you don't have to worry so much about complicated rules for testing. You can just base your answer on the results.

Since the testing is all done on a copy, it should be safe. Be sure to save all your work before though!

To use, put put your list of names in a workbook and name the range with that list "NamesToTest":

Then put this code in the same workbook and run it:

Sub CheckNameUsage()
Dim WorkbookWithList As Excel.Workbook
Dim WorkbookWithNames As Excel.Workbook
Dim TempWb As Excel.Workbook
Dim cell As Excel.Range
Dim NameToCheck As String
Dim ws As Excel.Worksheet
Dim ErrorRange As Excel.Range
Dim ErrorsBefore As Long
Dim ErrorsAfter As Long
Dim NameUsed As Boolean

Set WorkbookWithList = ThisWorkbook
Set WorkbookWithNames = Workbooks("SO - wb to test.xlsx")    'adjust to suit
WorkbookWithNames.Worksheets.Copy    'Workbooks.Add(WorkbookWithNames.FullName)
Set TempWb = ActiveWorkbook

For Each cell In WorkbookWithList.Names("NamesToTest").RefersToRange.Cells
    NameToCheck = cell.Value
    ErrorsBefore = 0
    For Each ws In TempWb.Worksheets
        Set ErrorRange = Nothing
        On Error Resume Next
        Set ErrorRange = ws.Cells.SpecialCells(xlCellTypeFormulas, 16)
        On Error GoTo 0
        If Not ErrorRange Is Nothing Then
            ErrorsBefore = ErrorsBefore + ErrorRange.Cells.Count
        End If
    Next ws
    TempWb.Names(NameToCheck).Delete
    ErrorsAfter = 0
    For Each ws In TempWb.Worksheets
        Set ErrorRange = Nothing
        On Error Resume Next
        Set ErrorRange = ws.Cells.SpecialCells(xlCellTypeFormulas, 16)
        On Error GoTo 0
        If Not ErrorRange Is Nothing Then
            ErrorsAfter = ErrorsAfter + ErrorRange.Cells.Count
        End If
    Next ws
    NameUsed = True
    If ErrorsBefore = ErrorsAfter Then
        NameUsed = False
    End If
    Debug.Print NameToCheck; " - Errors Before = " & ErrorsBefore; ", Errors After = " & ErrorsAfter; ", Used = " & NameUsed; ""
Next cell
TempWb.Close False
End Sub

The results will show in the Debug window:

The code is hopefully fairly self-explanatory. SpecialCells is worth knowing about, so read up on it if necessary. In this case it identifies cells with errors - that's the 16 argument.

Note that this only checks for workbook-level names. You could add checks for worksheet-level if necessary.

Romaineromains

The cell address of what? – Romaineromains

Answer 3

The following code works for me. The interesting points are

1) You can use the method range.ShowDependents to draw arrows to cells that are dependent on that range. When you are done, use range.ShowDependents True to remove the arrows.

2) Once the arrows are drawn, range.NavigateArrow can follow those arrows, and return the resulting range. I was unable to find any documentation on what happens if there are no dependent ranges. By experimenting, I was able to determine, that it will return the original range if there are no dependents.

Sub test_for_dependents(nm As Name)
    Dim nm_rng As Range, result As Range
    Dim i As Long

    Set nm_rng = nm.RefersToRange
    nm_rng.ShowDependents
    Set result = nm_rng.NavigateArrow(False, 1, 1)
    If result.Parent.Name = nm_rng.Parent.Name And result.Row = nm_rng.Row _
        And result.Column = nm_rng.Column Then
        MsgBox "Named range """ & nm.Name & """ isn't used!"
    End If
    nm_rng.ShowDependents True

    Set nm_rng = Nothing
    Set result = Nothing
End Sub

Sub test_all_names()
    Dim nm As Name
    Dim sht As Worksheet

    For Each nm In ThisWorkbook.Names
        test_for_dependents nm
    Next nm

    For Each sht In ThisWorkbook.Sheets
        For Each nm In sht.Names
            test_for_dependents nm
        Next nm
    Next sht

    Set nm = Nothing
    Set sht = Nothing
End Sub

Josey

Answer 4

The following NamesInCells macro reports the number of formula cells referencing each defined name (named range) in the active workbook. Results are in columns A:D (Scope, Name, RefersTo, Cells) starting at row 1 of the workbook's NamesInCells worksheet. If that worksheet does not exist, it will be added after the last sheet.

For each Name that is Visible (not hidden), the macro uses Private Function Formula_Errors to determine how many formula cells have errors before and after the Name's RefersTo property is made invalid. The before and after difference is the number of cells referencing that Name in a formula. However, if a Name is used in a cell formula that produced an error before, the after result will be the same for that cell. This issue is resolved by Private Function Prior_Errors which determines if the Name appears in an error cell's formula before the Name was made invalid. The InStr method used by Prior_Errors is imperfect, but only for formulas that had errors before initiating the macro (hopefully few). Also, a Name with workbook scope and a duplicate Name with sheet scope might be extraneously counted if they are in separate formulas that had initial errors.

This macro was inspired by Doug Glancy's answer above: https://mcmap.net/q/1708405/-find-where-named-ranges-are-being-used-in-big-workbook

Public Sub NamesInCells()
    Const myName As String = "NamesInCells"
    Dim WB As Workbook, oName As Name, A() As Variant, vCells As Variant
    Dim sScope As String, sName As String, sRefersTo As String
    Dim nRows As Long, nR As Long, nBase As Long, n As Integer
    Set WB = ActiveWorkbook
    nRows = WB.Names.Count
    If nRows = 0 Then
        MsgBox "There are no defined names in the active workbook", _
            vbInformation, myName
        Exit Sub
    End If
    nRows = nRows + 1
    ReDim A(1 To 4, 1 To nRows)
    nR = 1
    A(1, 1) = "Scope"
    A(2, 1) = "Name"
    A(3, 1) = "RefersTo"
    A(4, 1) = "Cells"
    nBase = Formula_Errors(WB)
    For Each oName In WB.Names
        With oName
            If .Visible Then 'skip hidden names
                n = InStrRev(.Name, "!")
                If n = 0 Then
                    sScope = "Workbook"
                    sName = .Name
                ElseIf n > 1 Then
                    sScope = Left(.Name, (n - 1))
                    sName = Mid(.Name, (n + 1))
                End If
                sRefersTo = .RefersTo
                If Left(sScope, 1) = "'" Then _
                    sScope = Mid(sScope, 2, (Len(sScope) - 2))
                .RefersTo = "#REF!"
                vCells = Formula_Errors(WB) - nBase
                .RefersTo = sRefersTo
                vCells = vCells + Prior_Errors(WB, .Name)
                nR = nR + 1
                A(1, nR) = sScope
                A(2, nR) = sName
                A(3, nR) = "'" & sRefersTo
                A(4, nR) = vCells
            End If
        End With
    Next oName
    If nR < 2 Then
        MsgBox "There are no visible defined names in the active workbook", _
            vbInformation, myName
        Exit Sub
    ElseIf nR < nRows Then
        ReDim Preserve A(1 To 4, 1 To nR)
    End If
    On Error Resume Next
        With WB
            .Worksheets(myName).Activate
            If Err = 0 Then
                Range("A:D").Clear
            Else
                .Worksheets.Add After:=.Sheets(.Sheets.Count)
                ActiveSheet.Name = myName
            End If
        End With
    On Error GoTo 0
    Range("A1").Select
    Selection.Resize(nR, 4).Value = Application.Transpose(A)
End Sub

Private Function Formula_Errors(WB As Workbook) As Long
    Dim WS As Worksheet, R As Range, nCount As Long
    For Each WS In WB.Worksheets
        On Error Resume Next
            Set R = WS.Cells.SpecialCells(xlCellTypeFormulas, xlErrors)
            If Err = 0 Then nCount = nCount + R.Count
        On Error GoTo 0
    Next WS
    Formula_Errors = nCount
End Function

Private Function Prior_Errors(WB As Workbook, Name As String) As Long
    Dim WS As Worksheet, R As Range, rCell As Range, nCount As Long
    Dim sWS As String, sN As String, sF As String, n As Integer
    n = InStrRev(Name, "!")
    If n > 1 Then
        sN = Mid(Name, (n + 1))
        sWS = Left(Name, (n - 1))
        If Left(sWS, 1) = "'" Then sWS = Mid(sWS, 2, (Len(sWS) - 2))
    End If
    For Each WS In WB.Worksheets
        On Error Resume Next
            Set R = WS.Cells.SpecialCells(xlCellTypeFormulas, xlErrors)
            If Err = 0 Then
                For Each rCell In R
                    sF = rCell.Formula
                    If WS.Name = sWS Then
                        If InStr(1, sF, sN, vbBinaryCompare) > 0 Then
                            nCount = nCount + 1
                        End If
                    ElseIf InStr(1, sF, Name, vbBinaryCompare) > 0 Then
                        nCount = nCount + 1
                    End If
                Next rCell
            End If
        On Error GoTo 0
    Next WS
    Prior_Errors = nCount
End Function

Whaler