Working With Specific Named Ranges

[Opv]

I'm having a bit of trouble grasping a particular aspect of working with named ranges. I have no problem creating named ranges, referring to named ranges or deleting all named ranges within the entire workbook. However, I can't to figure out how to drill down and modify or delete a specific range name using VBA.

I have a range named HEADING assigned to my worksheet header row, which consists of Range("A7:J7"). I then have a snippet of code which loops through that range and assigns a name to each cell within that range based on the value within each cell within HEADING. My problem arises when I make changes to my worksheet header row, I want to be able to loop back through the HEADING range, delete the existing individual cell names and reassign new names based on the changed value within each cell. Would someone please point me in the right direction.

Thanks

[Kenneth Hobs]

Set up a Worksheet Change Event. Search the forum for the term, Intersect, for examples. This method limits the changes to a few cells to watch and then triggers the code to act on the changes.

[Opv]

I think I've figured out how to address the specific range name that needs to be changed; however, in so doing I realized a different issue. Over time some cells have ended up having more than one name assigned to the same cell. Is there a way to detect if a specific cell has more than one name assigned?

[Kenneth Hobs]

Sub MNames()
Dim n As Name, r As Range
'On Error Resume Next
ThisWorkbook.Names.Add "ken", Range("A1")
ThisWorkbook.Names.Add "kenn", Range("A1")

For Each n In ThisWorkbook.Names
Set r = n.RefersToRange
If Not r Is Nothing Then MsgBox (n.Name & vbLf & r.Address)
Next n
End Sub

[Opv]

Sub MNames()
Dim n As Name, r As Range
'On Error Resume Next
ThisWorkbook.Names.Add "ken", Range("A1")
ThisWorkbook.Names.Add "kenn", Range("A1")

For Each n In ThisWorkbook.Names
Set r = n.RefersToRange
If Not r Is Nothing Then MsgBox (n.Name & vbLf & r.Address)
Next n
End Sub

Thanks, Kenneth. That appears to have helped me over the hump. I've modified your code to accommodate what I'm wanting to do. It seems to work but may could be streamlined a bit. What do you think?


Sub MNames()
Dim n As Name, cel As Range, r As Range
On Error Resume Next

'Delete existing names assigned to cells in HEADING range
For Each n In ThisWorkbook.Names
Set r = n.RefersToRange
If r.Row = ThisWorkbook.Sheets(1).Range("HEADING").Row And _
n.Name <> "HEADING" And _
Not r Is Nothing Then r.Name.Delete
Next n

'Assign new names to HEADING range
For Each cel In Range("HEADING").Cells
If cel.Value <> "" Then
cel.Name = cel.Value
End If
Next cel

On Error GoTo 0

End Sub

[Kenneth Hobs]

I would use the worksheet object method that I explained. e.g.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim nRange As Range, c As Range, n As Name
On Error Resume Next

Set nRange = Range("A1", Range("XFD1").End(xlToLeft))
Set nRange = Intersect(Target, nRange)
If nRange Is Nothing Then Exit Sub

For Each c In nRange
For Each n In ThisWorkbook.Names
If n.RefersToRange.Address = c.Address Then
n.Delete
ThisWorkbook.Names.Add c.Value2, c
GoTo NextN
End If
NextN:
Next n
Next c
End Sub

[Opv]

I would use the worksheet object method that I explained. e.g.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim nRange As Range, c As Range, n As Name
On Error Resume Next

Set nRange = Range("A1", Range("XFD1").End(xlToLeft))
Set nRange = Intersect(Target, nRange)
If nRange Is Nothing Then Exit Sub

For Each c In nRange
For Each n In ThisWorkbook.Names
If n.RefersToRange.Address = c.Address Then
n.Delete
ThisWorkbook.Names.Add c.Value2, c
GoTo NextN
End If
NextN:
Next n
Next c
End Sub

Thanks. I figured there was a more concise way to accomplish my goal. I had intended on incorporating the script into a worksheet.change event once I figured out how to make it work.

[SamT]

You can shorten
Set nRange = Range("A1", Range("XFD1").End(xlToLeft))
Set nRange = Intersect(Target, nRange) To
Set nRange = Intersect(Target, Rows(1))

[Opv]

You can shorten
Set nRange = Range("A1", Range("XFD1").End(xlToLeft))
Set nRange = Intersect(Target, nRange) To
Set nRange = Intersect(Target, Rows(1))

Thanks