VBA to remove named ranges in batches from excel workbook-CodePudding

Sometimes our workbooks at work get so overloaded with named ranges, which we don't even use, that the tool we normally use to remove names, or even the name manager, will no longer function. I did some digging around here and after finding this post: VBA Remove 100k named ranges, I started using the below code:

Sub dlname()

Dim j As Long

For j = 20000 To 1 Step -1
 If j <= ActiveWorkbook.Names.Count Then
   ActiveWorkbook.Names(j).Delete
 End If
Next j
ActiveWorkbook.Save
End Sub

For the most part this gets the job done (very slowly) however it periodically just stops working, and I'd prefer for this to be done on a loop until the job is done with the workbook being saved every time. If I use code that doesn't try and do the job in chunks then I just get a memory error so I'm pretty sure it needs to be done piece meal.

Sorry I am not a coder so I'm unsure how to update. Any help would be appreciated.

Thanks,

CodePudding user response：

I don't see anything really "wrong" with your code - it could be tidied up a bit, but the essential process is the same:

'remove all names from activeworkbook
Sub RemoveNames()
    With ActiveWorkbook.Names
        Do While .Count > 0
            .Item(1).Delete
        Loop
    End With
End Sub

'create a lot of names for testing...
Sub AddNames()
    Dim i As Long
    For i = 1 To 10000
        ActiveWorkbook.Names.Add "Test_" & Format(i, "0000000"), ActiveSheet.Cells(i, 1)
    Next i
End Sub

CodePudding user response：

The process of deleting UNUSED names can be complicated. This is an example of searching through all the defined names in a workbook and deleting ONLY those NOT USED in a formula.

The bit at the top and bottom of the routine will greatly speed up the process...

Option Explicit

Sub DeleteAllUnusedNames()
    '--- disable all interactions for SPEED
    With Application
        .EnableEvents = False
        .DisplayAlerts = False
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
    End With
    
    Dim totalNames As Long
    Dim namesDeleted As Long
    
    Dim definedName As Variant
    For Each definedName In ThisWorkbook.names
        Dim nameIsUsed As Boolean
        nameIsUsed = True
        totalNames = totalNames   1
        
        Dim sheet As Worksheet
        For Each sheet In ThisWorkbook.Sheets
            If Not NameIsInFormula(definedName.name, sheet) Then
                nameIsUsed = False
                Exit For
            End If
        Next sheet
        
        If Not nameIsUsed Then
            namesDeleted = namesDeleted   1
            definedName.Delete
        End If
    Next definedName
    
    Debug.Print totalNames & " names found, " & namesDeleted & " deleted"
    
    '--- re-enable all interactions
    With Application
        .EnableEvents = True
        .DisplayAlerts = True
        .ScreenUpdating = True
        .Calculation = xlCalculationAutomatic
    End With
End Sub

Public Function NameIsInFormula(ByVal thisName As String, _
                                ByRef thisSheet As Worksheet) As Boolean
    On Error Resume Next
    Dim cellsWithFormulas As Range
    Set cellsWithFormulas = thisSheet.Cells.SpecialCells(xlCellTypeFormulas)
    If cellsWithFormulas Is Nothing Then
        NameIsInFormula = False
        Exit Function
    End If
    On Error GoTo 0
    
    Dim cellsFound As Range
    Set cellsFound = cellsWithFormulas.Find(What:=thisName, LookIn:=xlFormulas, _
                                            LookAt:=xlPart, MatchCase:=False, _
                                            SearchFormat:=False)
                                            
    '--- optional if you want to see where it is...
'    If Not cellsFound Is Nothing Then
'        Debug.Print vbTab & thisName & " found in " & _
'                    thisSheet.name & "!" & cellsFound.Address
'    End If
    
    NameIsInFormula = (Not cellsFound Is Nothing)
End Function