Find where named ranges are being used in big workbook

后端 未结 3 609
抹茶落季
抹茶落季 2020-12-18 06:22

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

相关标签:
3条回答
  • 2020-12-18 06:38

    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
    
    0 讨论(0)
  • 2020-12-18 06:40

    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":

    enter image description here

    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:

    enter image description here

    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.

    0 讨论(0)
  • 2020-12-18 06:46

    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
    

    enter image description here

    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

    enter image description here

    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

    enter image description here

    PHEW!!!

    0 讨论(0)
提交回复
热议问题