A quick and direct way to delete names in selection
In addition to @Storax 'es solution you might benefit from the fact that the relatively unknown function rng.Value(xlRangeValueXMLSpreadsheet)
(analyzing the entire sheet structure) returns also all existing names of a selected range as XML string. This saves further error handling.
Assign them to an array and delete them in a loop as follows:
Option Explicit ' code module header
Sub DelNamesInSelectedRange()
'a) Define selected range by any method
Dim selectedRng As Range
Set selectedRng = Application.Selection
'b) Get all names in selected range via XMLSpreadsheet analyze
Dim myNames
myNames = GetNames(selectedRng)
'c) Delete received names
Dim i As Long
For i = 1 To UBound(myNames) - 2
ThisWorkbook.Names(myNames(i)).Delete
Next
End Sub
Help function GetNames()
Applying some XML logic including namespaces via XPath search string* allows to extract all names of the specified range and to return an array of all existing names.
A sample extract of this xml might be:
<?xml version="1.0"?>
<?mso-application progid="Excel.Sheet"?>
<Workbook xmlns="urn:schemas-microsoft-com:office:spreadsheet"
xmlns:o="urn:schemas-microsoft-com:office:office"
xmlns:x="urn:schemas-microsoft-com:office:excel"
xmlns:ss="urn:schemas-microsoft-com:office:spreadsheet"
xmlns:html="http://www.w3.org/TR/REC-html40">
' <!-- ... omitting styles etc -->
' <!-- ... -->
' <Names>
' <NamedRange ss:Name="FirstName" ss:RefersTo="=Sheet1!R1C1"/>
' <NamedRange ss:Name="SecondName" ss:RefersTo="=Sheet1!R3C1"/>
' <NamedRange ss:Name="LastName" ss:RefersTo="=Sheet1!R2C3"/>
' </Names>
' <!-- ... -->
'</Workbook>
Function GetNames(rng As Range)
'[0]Get Value(11)
Dim s As String
s = rng.Value(xlRangeValueXMLSpreadsheet) ' or: rng.Value(11)
'[1]Set xml document to memory
Dim xDoc As Object: Set xDoc = CreateObject("MSXML2.DOMDocument.6.0")
'[2]Add namespaces
xDoc.SetProperty "SelectionNamespaces", _
"xmlns:ss='urn:schemas-microsoft-com:office:spreadsheet' " & _
"xmlns:ht='http://www.w3.org/TR/REC-html40'"
'[3]Get cells with Names/NamedRange/@Name
If xDoc.LoadXML(s) Then ' load wellformed string content
Dim cell As Object, cells As Object
'Set cells = xDoc.SelectNodes("//ss:Cell[ss:Data/@ss:Type='Number']") ' XPath using namespace prefixes
Set cells = xDoc.SelectNodes("//ss:Names/ss:NamedRange/@ss:Name") ' XPath using namespace prefixes
Dim tmp(): ReDim tmp(1 To cells.Length)
For Each cell In cells
Dim i As Long: i = i + 1
tmp(i) = cell.Text
Next cell
'[4]return "flat" array
GetNames = tmp
End If
End Function