Selectively Delete Defined Names

[Kev]

I am trying to selectively delete defined names from an excel workbook. The
problem stems from copying excel sheets from file A to file B as it also
copys the list of defined names to file B even though file B does not
reference these defined names. I now have files with 30,000+ unused defined
names.

I can delete all names using code such as

Dim x%
For x = 1 To ActiveWorkbook.Names.Count - y + 1
ActiveWorkbook.Names(x).Delete
x = 1
y = y + 1
Next

However I would like to selectively delete defined names if and only if they
are not referenced in the workbook. I have tried using
Worksheetfunction.find, howevere if the defined name is not found it causes
an error in the Macro. I have used the on error / go to functions but it only
seams to work once (error occurs the second time a defined name is not found).

Any help would be greatly appreciated.

Thanks

 

[Dave Peterson]

Instead of using worksheetfunction.find(), you could use VBA's own Instr().

Or even the equivalent of Edit|Find.

But even better (unless this is a learning excercise), you can get a copy of Jan
Karel Pieterse's (with Charles Williams and Matthew Henson) Name Manager:

You can find it at:
NameManager.Zip from http://www.oaltd.co.uk/mvp

IIRC, it has the ability to search to find out if the names are used or not
(although, 30,000 unused names could take some time!).

ps. Don't forget that some of those names could be use in code or even used by
other workbooks.

 

[Anant Basant]

I generally use the following code for my own use.

But as Dave has rightly said the utility created by JKP is far superior.

Sub FindNamesNotBeingUsed()

Dim n As Name
Dim wks As Worksheet
Dim i As Long
Set wks = Worksheets.Add

i = 1
For Each n In ActiveWorkbook.Names
If NameBeingUsed(n.Name) = False Then
wks.Cells(i, 1).Value = n.Name
wks.Cells(i, 2).Value = "'" & n.RefersTo
i = i + 1
End If
Next n

End Sub

Function NameBeingUsed(strName As String) As Variant
Dim ws As Worksheet
Dim rngCellFound As Range
Dim shtName As String
Dim cellAdd As String

For Each ws In ActiveWorkbook.Worksheets
Set rngCellFound = ws.Cells.Find(What:=strName, After:=ws.Cells(1),
LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext,
MatchCase:= _
False, SearchFormat:=False)
If Not rngCellFound Is Nothing Then
shtName = rngCellFound.Parent.Name
cellAdd = rngCellFound.Address
NameBeingUsed = shtName & ", " & cellAdd
Exit Function
End If
Next ws
NameBeingUsed = False
End Function