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

Question

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,

Answer 1

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

Answer 2

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