Name a Cell Range After Checking it Doesn't Have a Range Name

user_10264254 0
Viewed 78

I'm trying to cycle through a selection of cells and rename those cells based on text values on the spreadsheet.

Sub naming()

    Dim cel As Range
    Dim selectedRange As Range
    Dim to_offset As Integer

    Set selectedRange = Application.Selection

    Answer = InputBox("Column Where Named Are?")
    col_number = Range(Answer & 1).Column

    For Each cel In selectedRange.Cells
        cel.Name.Delete
        to_offset = col_number - cel.Column
        cel.Name = cel.Offset(0, to_offset).Value
    Next cel

End Sub

The delete command is the problem - so I thought I'd check for names using Len() but get a 1004 error.

If there are no names already defined for the cell it works (but I can't leave the delete code in).
If there are names already defined for the cell it works (and I use the delete).

I need to use the delete for existing names - but have it step over blank names.

named-ranges vba excel
2 Answers

A quick and dirty way would be to wrap the line in question between On Error Resume Next and On Error Goto 0, so the code would look like that

    On Error Resume Next   'skip line in case of an error
    cel.Name.Delete
    On Error GoTo 0        'reset error handling

Using On Error Resume Next tells VBA to ignore the error and continue on. There are specific occasions when this is useful. Most of the time you should avoid using it. I think this might be a case where you could use it.

Or you wrap the code in a sub

Sub deleteName(rg As Range)

    On Error GoTo EH
    rg.Name.Delete
    
    Exit Sub

EH:
    
End Sub

and use it like that

For Each cel In selectedRange.Cells
        deleteName cel
        to_offset = col_number - cel.Column
        cel.Name = cel.Offset(0, to_offset).Value
Next cel

But in this case this is IMHO not much of a difference.

Further reading on Error handling

user_66009400

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
user_64602970
Related