I need your help. I found the attached vba code but when I run the code I am getting a very strange 1004 error. Could you please give an explanation or try to fix this error?
Thank you so much all!
' Module to remove all hidden names on active workbook
Sub Remove_Hidden_Names()
' Dimension variables.
Dim xName As Variant
Dim Result As Variant
Dim Vis As Variant
' Loop once for each name in the workbook.
For Each xName In ActiveWorkbook.Names
'If a name is not visible (it is hidden)...
If xName.Visible = True Then
Vis = "Visible"
Else
Vis = "Hidden"
End If
' ...ask whether or not to delete the name.
Result = MsgBox(prompt:="Delete " & Vis & " Name " & _
Chr(10) & xName.Name & "?" & Chr(10) & _
"Which refers to: " & Chr(10) & xName.RefersTo, _
Buttons:=vbYesNo)
' If the result is true, then delete the name.
If Result = vbYes Then xName.Delete
' Loop to the next name.
Next xName
End Sub
These Excel built-in range names appear in the Excel name manager when using SUMIFS,IFERROR, COUNTIFS and other formulas.
There are a lot of ways around this, as suggested in the comments.
You can add either of these:
If Not xName.Name Like "_xlfn*" Then
'Or
If InStr(xName.Name, "_xlfn") = 0 Then
first thing in the loop (don't forget to close it), or something similar.
If you for some reason still want to see it, you can add it to the delete if:
If Result = vbYes And Not xName.Name Like "_xlfn*" Then xName.Delete
Related
i do have several hundred of excel files. Every excel file contains a makro in the "workbooks_open" method. I want to open all these files, comment out the code, save and close the file.
a loop through all files with open/close is not a problem, but with the changing of the vba code i have no idea.
many thanks in advance!
Sub test()
Dim Path as string = "C:\123\"
Dim cDir As String
cDir = Dir(Path & "*.xlsx")
Do While cDir <> ""
Application.DisplayAlerts = False
'### open
Workbooks.Open Filename:=Path & cDir
'### here i want to deactivate/comment out the makro in the workbook_open method
'### save
ActiveWorkbook.Save
ActiveWorkbook.Saved = True
'### close
ActiveWorkbook.Close False
cDir = Dir
Loop
End Sub
To access the code of a workbook using code, you need to allow access to the VBE via code - see https://stackoverflow.com/a/11680865/7599798 how to do so.
You access all the coding stuff of a workbook using its VBProject-Property.
If you want to use the Types and Constants of the Project, add a reference to Microsoft Visual Basic for Applications Extensibility
The VBProject contains a collection of Components VBComponents, this is the list you see in the VBE in the project window, it contains all modules, classes and forms.
The Workbook-Module has the Name ThisWorkbook and it's type = 100 (use vbext_ct_Document if you have added the mentioned reference)
To access the code of a module, use the property CodeModule of the component.
The lines of code can be fetched using the lines-property of CodeModule, you need to pass two parameters (startrow and numbers of rows).
The lines-property is read only, if you want to change code, you can use the methods InsertLines, DeleteLines and ReplaceLines
Have a look to the next routine to see how it could look like. It will simply replace the Workbook_Open()-routine with Workbook_Open_BACKUP() so it will no longer fire when the workbook is opened.
Sub RemoveOnOpen(wb As Workbook)
Dim i As Long
With wb.VBProject
For i = 1 to .VBComponents.Count
' Debug.Print .VBComponents(i).Type, .VBComponents(i).Name
If .VBComponents(i).Type = vbext_ct_Document And .VBComponents(i).Name = "ThisWorkbook" Then
Dim row As Long
For row = 1 To .VBComponents(i).CodeModule.CountOfLines
Dim module As CodeModule, line As String
Set module = .VBComponents(i).CodeModule
line = Trim(module.Lines(row, 1))
If Left(line, 27) = "Private Sub Workbook_Open()" Then
module.ReplaceLine row, Replace(line, "Workbook_Open()", "Workbook_Open_BACKUP()")
End If
Next
End If
Next i
End With
End Sub
Update: As T.M. noted, the name of the Workbook module may be different if used in a different language environment, you should check this.
I also added a Trim-statement when checking the code line for the Sub.
Please, use the next Sub. It should be called by the code iterating between all workbooks to be changed:
Sub ComSpecSub(wb As Workbook, moduleName As String, strLine As String)
Dim objThisWb As VBComponent, CodeM As CodeModule, i As Long, j As Long
Set objThisWb = wb.VBProject.VBComponents("ThisWorkbook")
Set CodeM = objThisWb.CodeModule
If CodeM.Find(strLine, 1, 1, CodeM.CountOfLines, 1, False) = True Then
For i = 1 To CodeM.CountOfLines
If InStr(CodeM.lines(i, 1), strLine) > 0 Then
If left(CodeM.lines(i, 1), 1) = "'" Then Exit Sub 'already commented...
'if running the code again
Do While i + j <= CodeM.CountOfLines
CodeM.ReplaceLine i + j, "'" & CodeM.lines(i + j, 1)
If InStr(CodeM.lines(i + j, 1), "End Sub") > 0 Then Exit Do
j = j + 1
Loop
End If
Next i
End If
End Sub
The above code needs a reference to 'Microsoft Visual Basic for Applications Extensibility'
It should be called from your code as:
ComSpecSub ActiveWorkbook, "ThisWorkbook", "Private Sub Workbook_Open()"
ActiveWorkbook.Close True
If adding the required reference looks problematic, please firstly run the next code, which will add it automatically:
Sub addExtenssibilityReference()
'Add a reference to 'Microsoft Visual Basic for Applications Extensibilty 5.3':
ThisWorkbook.VBProject.References.AddFromGuid _
GUID:="{0002E157-0000-0000-C000-000000000046}", _
Major:=5, Minor:=3
End Sub
Language independant & no loops
In addition to the valid answers of #FunThomas (following his renaming idea) and #FaneDuru I demonstrate an approach with two benefits:
the component ThisWorkbook can be found independantly from regional language settings via wb.VBProject.VBComponents(wb.CodeName),
as workbooks can be referenced not only by their name string which may differ for other languages than English,
but also via a workbook's wb.CodeName property (similar for sheets);
the effective procedure start row can be found in one go via
.ProcBodyLine(srchProcName, 0), where the zero input defines a sub or function procedure kind (other than Get|Let|Set props);
Further hints:
Needs a library reference to Microsoft Visual Basic for Applications Extensibility 5.3 (c.f. also #FaneDuru's progamatical approach).
Generally replacing a code line by another should consider possible line breaks ( _) resulting in two or several lines, too; due to the brevity of the procedure I don't assume a line break before "Workbook_Open" (like e.g. `Private Sub _".
Sub BackUp(wb as WorkBook, Optional ByVal srchProcName As String = "Workbook_Open")
'Purp: change a given procedures name in ThisWorkbook (e.g. "Workbook_Open") by adding "_BACKUP"
'0) Define backup name string
Dim backupName As String: backupName = srchProcName & "_BACKUP"
'1) Access ThisWorkbook directly by its CodeName (independant from regional language settings)!
Dim myComp As VBIDE.VBComponent
Set myComp = wb.VBProject.VBComponents(wb.CodeName)
'Debug.Print "** Code(Name): " & wb.CodeName & " (Local Name: " & myComp.Name & ")"
'2) Search directly for the effective start row of srchProcName (e.g. "Workbook_Open")
Dim effectiveRow As Long
With myComp.CodeModule ' the component's code module
On Error Resume Next
effectiveRow = .ProcBodyLine(srchProcName, 0) ' find effective row of search procedure
Select Case Err.Number
Case 0
Dim newContent As String
newContent = Replace(Trim(.Lines(effectiveRow, 1)), srchProcName, backupName)
.ReplaceLine effectiveRow, newContent
Debug.Print "** " & wb.Name & vbNewLine & "" _
; " Changed procedure '" & srchProcName & "' in row " & effectiveRow & _
" to " & backupName
Case 35
Debug.Print "** " & wb.Name & vbNewLine & _
" Error " & Err.Number & " " & Err.Description & vbNewLine & _
" Procedure '" & srchProcName & "' doesn't exist!" & vbNewLine & _
" (Possibly already 'backupped')": Err.Clear
Case Else
Debug.Print "** " & wb.Name & vbNewLine & _
" Error " & Err.Number & " " & Err.Description: Err.Clear
End Select
End With
End Sub
Example output in VB Editor's immeditate window
Inserting Backup ActiveWorkbook or a pre-set Backup wb in your code should suffice to rename existing "Workbook_Open" procedures by a "_BACKUP" suffix.
** ExampleWorkbook147.xlsm
Changed procedure 'Workbook_Open' in row 8 to Workbook_Open_BACKUP
In reply of #T.M comment and nice answer:
The next solution uses Find, which besides returning True when the searched string has been found, it modifies the StartLine parameter, if used as a variable. Then, since the question also involves commenting all the procedure lines, not only changing the declaration line, it will do it, without iteration, too:
Sub findProcThisWb(Optional wb As Workbook, Optional strLine As String = "Workbook_Open")
Dim thisWBCodeM As CodeModule, foundLine As Long, ProcExists As Boolean, arrPr
Dim procName As String, strCodeLine As String, strProcedure As String, strComProc As String
If wb Is Nothing Then Set wb = ThisWorkbook
Set thisWBCodeM = wb.VBProject.VBComponents(wb.CodeName).CodeModule
foundLine = 1 'initialize the line where from Find starts searching
Dim noLines As Long 'it will keep the found procedure number of lines
With thisWBCodeM
' ProcExists = .Find(strLine, foundLine, .CountOfLines, 1, -1, False, False) ' OP
ProcExists = .Find(strLine, foundLine, 1, .CountOfLines, -1, False, False) ' << Edit/2022-01-24 corr. argument order
Debug.Print foundLine: ' the line of the found procedure, if it has been found!
If ProcExists Then
strCodeLine = .lines(foundLine, 1) 'return the whole line
Debug.Print strCodeLine 'the whole line where the searched string has been found
procName = .ProcOfLine(foundLine, vbext_pk_Proc): Debug.Print "Proc name = " & procName
noLines = .ProcCountLines(procName, vbext_pk_Proc): Debug.Print "Number of procedure lines = " & noLines
strProcedure = .lines(foundLine, noLines): Debug.Print "The whole procedure:" & vbLf & strProcedure
arrPr = Split(strProcedure, vbLf)
strComProc = "'" & Join(arrPr, vbLf & "'"): Debug.Print "The whole commented procedure:" & vbLf; strComProc
'Delete the actual procedure lines:
.DeleteLines foundLine, noLines - 1 ' Edit 2022-01-24: -1
'Add the commented procedure code (from string, but not in the same place, after the declaration lines):
.AddFromString strComProc
End If
End With
End Sub
After a recent windows update, a previous Excel vba script that was working, no longer functions correctly.
The macro operation, when working, opens a csv file that is defined in the active workbook as String aString. The csv file contains a list of variables and corresponding values for those variables. The macro returns the original active workbook and reads the defined named cells in the active workbook and updates those named cells with the values defined in the csv file.
The issue appears to be that despite returning to the original active workbook the command to generate the For loop to cycle through the named cells no longer returns a value for the variable name or which worksheet the variable lives in.
The command is:
' Process to update name values
Workbooks(strWorkBook).Activate
' Windows(strWorkBook).Activate
' Dim nm As Variant
' For Each nm In ActiveWorkbook.Names
For Each nm In Workbooks(strWorkBook).Names
varname = nm.Name
MsgBox "varname " & varname & " nm " & nm
varsheet = Range(nm).Parent.Name
MsgBox "varsheet " & varsheet
The message for the varname is now:
The message should read varname aString nm $D$4
Pretty sure it is update version related, as in Excel build Version 1902 (Build 11328.20318) it works but not in Version 2002 (Build 12527.21416)
Thanks in advance for your help. Related forums point to security update issues with Windows but no solutions I can implement yet.
======================================================
Update from further testing:
I created a new workbook and built the macro that is failing in the new workbook using Excel Version 2002 (Build 12527.21416). The macro runs perfectly in the new version of the Excel file but continues to produce the error message above in the legacy file.
I'm suspecting there are some issues related to security updates in the Version 2002 build that are not compatible with the Version 1902 build but cannot identify what the issues are.
The macro that runs in the new version but not the original document is:
Public Sub testName()
Dim filePath As String
Dim inFilePath As String
Dim inCase As String
'On Error GoTo ErrorHandler
Application.ScreenUpdating = False
Application.EnableEvents = False
'----------------------------------
' Find path for input file
strWorkBook = ActiveWorkbook.Name
' MsgBox strWorkBook
filePath = Range("aString").Value
tmpsep = InStrRev(filePath, "\")
' Input file workbook name
inCase = Right(filePath, Len(filePath) - tmpsep)
'Input file full path
inFilePath = Left(filePath, Len(filePath) - Len(inCase))
' Open input data file
Workbooks.Open Filename:=filePath
'' Find last row in file
' Call FindLastRow.FindLastRow(lRow)
' rngend = lRow + 2
'' MsgBox rngend
Workbooks(strWorkBook).Activate
'
' VBA script to read external CSV file' For Each nm In ActiveWorkbook.Names
For Each nm In Workbooks(strWorkBook).Names
varname = nm.Name
MsgBox "varname " & varname & " nm " & nm
varsheet = Range(nm).Parent.Name
MsgBox "varsheet " & varsheet
varcell = nm.RefersToRange.Address(False, False)
NextIteration:
Next nm
End Sub
Your problem stems from the misdeclaration of the variable Nm. In fact, it's not declared (and you are missing Option Explicit at the top of your module) which makes it a Variant. Excel appears unable to fit the Name object into the variant as you intend within the rather complicated environment you create (more about that further down). This code will work.
Dim Nm As Name
Dim varName As String
Dim varSheet As String
Dim varCell As String
' For Each Nm In ActiveWorkbook.Names
For Each Nm In Workbooks(strWorkBook).Names
With Nm
varName = .Name
varSheet = .RefersToRange.Parent.Name
varCell = .RefersToRange.Address(0, 0)
End With
MsgBox "Named range """ & varName & """ refers to range" & vbCr & _
varCell & " on sheet """ & varSheet & """."
Next Nm
I tested the above code on the ActiveWorkbook but it should work on any other as well. I tested in Excel 365 but that shouldn't make a difference, either.
The complication mentioned above stems from this part of your code, Range(nm).Parent.Name. In this context nm is a string. But in the context of your loop nm is a Name object. So, whereas in the older version apparently the default property of the Name object was the referenced range address it now would appear to be something else. It doesn't really matter because the Name object has several properties from which the referenced range can be extracted as a range or its address, and once you specify the one you want to use there is no need to ask VBA to use the default.
Incidentally, Range("anything")will always be on the ActiveSheet, and Range("Sheet13!A2:A4").Parent will return an error rather than Sheet13. Therefore, if you need to know the sheet of the range on which the named range resides you should look for another method of getting at it.
Problem solved thanks to this thread stackflow thread and user Jenn.
It seems that between Excel V1902 and V2002 a hidden variable _xlfn.SINGLE exists in the workbook. When the macro loops through, it sees the named range, cannot resolve its address or sheet location and stops. Not until running Jenn's code could I see the hidden variable.
The easiest solution was to include an IF loop to bypass this variable if defined and continue as normal (as per below). The sheet is working now but I will not get those 2 days of my life back.
For Each Nm In Workbooks(strWorkBook).Names
If Nm.Name Like "_xlfn*" Then
GoTo NextIteration
End If
With Nm
varName = .Name
varSheet = .RefersToRange.Parent.Name
varCell = .RefersToRange.Address(0, 0)
End With
MsgBox "Named range """ & varName & """ refers to range" & vbCr & _
varCell & " on sheet """ & varSheet & """."
NextIteration:
Next Nm
Thanks to those who commented on the thread and Variatus I will update those declarations.
I've been using a function from another StackOverflow question (I'm SO sorry I can't find the original answer!) to help go through a number of cells in Column L that contains a formula that spits our a hyperlinked filepath. It is meant to open each one (workbook), update the values, then save and close the workbook before opening the next one. See below.
Sub List_UpdateAndSave()
Dim lr As Long
Dim i As Integer
Dim WBSsource As Workbook
Dim FileNames As Variant
Dim msg As String
' Update the individual credit models
With ThisWorkbook.Sheets("List")
lr = .Cells(.Rows.Count, "L").End(xlUp).Row
FileNames = .Range("L2:L" & lr).Value
End With
For i = LBound(FileNames, 1) To UBound(FileNames, 1)
On Error Resume Next
If FileNames(i, 1) Like "*.xls*" Then
Set WBSsource = Workbooks.Open(FileNames(i, 1), _
ReadOnly:=False, _
Password:="", _
UpdateLinks:=3)
If Err = 0 Then
With WBSsource
'do stuff here
.Save
.Close True
End With
Else
msg = msg & FileNames(i, 1) & Chr(10)
On Error GoTo 0
End If
End If
Set WBSsource = Nothing
Next i
If Len(msg) > 0 Then
MsgBox "The Following Files Could Not Be Opened" & _
Chr(10) & msg, 48, "Error"
End If
End Sub
The problem now is I am using this to work on a Network drive, and as a result it cause pathing issues with the Connections/Edit Links part. Each of the files are stored on S:\... which as a result of using the Hyperlink formula, won't be able to find the source data. See below the example image of a file that as been opened through a hyperlink cell from my original workbook. When I go to update the Edit Links section of it, it shows these errors.
If I open that lettered drive in Windows Explorer and find the file, it works with no problems. Open, Update Values > Save > Close, it says unknown...
(but if I click Update values here they update correctly.)
If opened using a Hyperlink formula in a cell (Also directing to S:\..) it says it contains links that cannot be updated. I choose to edit links and they're all "Error: Source not found". The location on them also starts off with \\\corp\... and not S:\.
Anyway to fix this? Apologies for the long winded question.
I'm adding this as an answer as it contains code and is a bit long for a comment.
I'm not sure if it's what you're after though.
The code will take the mapped drive and return the network drive, or visa-versa for Excel files. DriveMap is the variable containing the final string - you may want to adapt into a function.
Sub UpdatePath()
Dim oFSO As Object
Dim oDrv As Object
Dim FileName As String
Dim DriveMap As String
Set oFSO = CreateObject("Scripting.FileSystemObject")
FileName = Range("A1")
If InStr(oFSO.GetExtensionName(FileName), "xls") > 0 Then
For Each oDrv In oFSO.drives
If oDrv.sharename <> "" Then
'Changes \\corp\.... to S:\
If InStr(FileName, oDrv.sharename) = 1 Then
DriveMap = Replace(FileName, oDrv.sharename, oDrv.Path)
End If
'Changes S:\ to \\corp\....
' If InStr(FileName, oDrv.Path) = 1 Then
' DriveMap = Replace(FileName, oDrv.Path, oDrv.sharename)
' End If
End If
Next oDrv
End If
End Sub
I have some code which looks for a value with a given sheet name in two separate workbooks.
What I want to do is when the first workbook does not have the sheet, instead of the following prompt coming up, it cancels/throws an error and using the error handling goes to the second spreadsheet. How do I do this?
Currently I am using this code to achieve this:
fFormString1 = "'" & wkBookRef1 & firstShtName & "'!$L$6/1000"
fFormString2 = "'" & wkBookRef2 & firstShtName & "'!$L$6/1000"
Application.DisplayAlerts = False 'Does nothing to the prompt
On Error GoTo tryTwo 'Following only throws error when prompt is canceled
ThisWorkbook.Sheets("Place").Range("E53").Formula = "=" & fFormString1
GoTo endTen
tryTwo:
ThisWorkbook.Sheets("Place").Range("E53").Formula = "=IFERROR(" & fFormString2 & ","""")"
On Error Resume Next
endTen:
Application.DisplayAlerts = True 'Does nothing to the prompt
Note: I wish to do this with the spreadsheet closed ideally. Or visually not present to improve speed and smoothness of operation for my client.
ExecuteExcel4Macro will return a value from a closed workbook. If the worksheet doesn't exist it will throw an error 1004 'A formula in this worksheet contains one or more invalid references.
ExternalWorksheetExists uses this to test it the worksheet exist.
Function ExternalWorksheetExists(FilePath As String, FileName As String, WorksheetName As String) As Boolean
If Right(FilePath, 1) <> "\" Then FilePath = FilePath & "\"
On Error Resume Next
Call ExecuteExcel4Macro("'" & FilePath & "[" & FileName & "]" & WorksheetName & "'!R3C3")
ExternalWorksheetExists = Err.Number = 0
On Error GoTo 0
End Function
When using ExecuteExcel4Macro, all references must be given as R1C1 strings. Here is an example of a valid string:
ExecuteExcel4Macro("'C:\Users\tinzina\Documents\[Book1.xlsm]Sheet1'!R6C12")
Borrowing heavily from Thomas' answer (full credit is due). However it seems that this didn't work for you.
Use ExecuteExcel4Macro but ascribe the value to the variable val. Then check if this is the error you are looking for Error(2023).
Please find the code below:
'Check if the sheet exists in the workbook, used to check which forecast file one should look in
Function ExtSheetExists(formString) As Boolean 'Form string is a formula string with both the worksheet and the workbook
Dim val As Variant
'Tries to execute formula and throws error if it doesn't exist
On Error Resume Next
val = ExecuteExcel4Macro(formString)
ExtSheetExists = (val <> Error(2023)) 'Returns False if the sheet does not exist based on Error 2023
On Error GoTo 0
End Function
In VBA Help for the RefersTo Property, they give this example of listing all the Names in a Wkb (fleshed out so you can run it as is)
Sub showNames()'from VBA Help for "RefersTo"
Dim newSheet As Worksheet
Set newSheet = Worksheets.Add
Dim i As Long, nm As Name
i = 1
For Each nm In ActiveWorkbook.Names
newSheet.Cells(i, 1).Value = nm.Name
newSheet.Cells(i, 2).Value = "'" & nm.RefersTo
i = i + 1
Next
newSheet.Columns("A:B").AutoFit
End Sub
When I run that on my current project, it turns up many Names that I thought were long gone. But here they are still hanging around and referring to places that no longer exist. I think this is what's slowing up my system and I'd love to get rid of those Names, but they don't show up in the Define Name window so where do I find them?
edit: Meant to mention that the Links item is greyed out for this Wbk.
Update
option 1
A manual method to delete corrupt names using R1C1 (I can recall JKP stating on another forum he had code to do this but he wasn't prepared to provide it for free)
Select Tools, Options and click the General tab.
Click the check box next to "R1C1 Reference Style", so that you change the current setting.
Press OK.
Excel will prompt you to change the name of any name (in all open workbooks!) that contains illegal characters.
Select Insert, name, define to delete the newly renamed names.
Set the R1C1 Reference style back the way you prefer using Tools, Options, General.
option 2
Chris Neilsen posted this at Any chance to delete programatically corrupt ranged names (with spaces) in Excel (2007/2010)
But, here's a possible alternative: SaveAs your workbook as a .xlsm
You should get a dialog complaining about invalid names, with a option
to rename and a Ok to All button. Once saved, close and reopen the
file, Save As an .xls and you should be good to go
Initial Post
Download Name Manager which is the stand out addin by Jan Karel Pieterse and Charles Williams for managing names
It will handle Names that
now error out as the ranges have been deleted (your issue),
link to other Workbooks,
are now corrupt
Plus it will convert global names to local sheet names, and vice versa and so on
- Updated Answer -
Since you know the names of the invalid ranges but can't see them in the Name Manager, you can try to delete them manually from the VBA Immediate window. The name you gave GrPix!patternListRange indicates a worksheet name so you should be able to delete it by typing
ActiveWorkbook.Names("GrPix!patternListRange").Delete
or
Sheets("GrPix").Names("patternListRange").Delete
in the Immediate Window
Original Answer
Have you tried deleting the invalid names via code? i.e.
For Each nm In ActiveWorkbook.Names
If InStr(nm.RefersTo, "OldFileName.xls") > 0 Then
nm.Delete
End If
Next nm
Here are two more solutions that may work for others searching on this topic, but these still don't fix my own particular Workbook.
I'm still looking.
This is from Aaron Blood and shows the R1C1 method mentioned by brettdj:
Sub RemoveDemonLinks()
Dim wbBook As Workbook
Dim nName As Name
Dim i As Long
Set wbBook = ActiveWorkbook
i = 0
If wbBook.Names.Count > 0 Then
With Application
.ReferenceStyle = xlR1C1
.ReferenceStyle = xlA1
End With
For Each nName In wbBook.Name
If InStr(nName.RefersTo, "#REF!") > 0 Then nName.Delete
i = i + 1
Next nName
If i > 0 Then MsgBox i & " corrupted names was deleted from " & wbBook.Name
End If
End Sub
This is from MS Help
' Module to remove all hidden names on active workbook
Sub Remove_Hidden_Names()
' Dimension variables.
Dim xName As Variant
Dim Result As Variant
Dim Vis As Variant
' Loop once for each name in the workbook.
For Each xName In ActiveWorkbook.Names
'If a name is not visible (it is hidden)...
If xName.Visible = True Then
Vis = "Visible"
Else
Vis = "Hidden"
End If
' ...ask whether or not to delete the name.
Result = MsgBox(prompt:="Delete " & Vis & " Name " & _
Chr(10) & xName.Name & "?" & Chr(10) & _
"Which refers to: " & Chr(10) & xName.RefersTo, _
Buttons:=vbYesNo)
' If the result is true, then delete the name.
If Result = vbYes Then xName.Delete
' Loop to the next name.
Next xName
End Sub