Can someone please tell me how to get this to work?
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
I'm trying to cycle through a selection of cells and rename those cells based on text values on the spreadsheet.
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
Any suggestions are welcome.
CodePudding user response:
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
CodePudding user response:
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