If the ActiveCell is part of a named range, this macro will select the entire named range.
This macro requires the CellInNamedRange function, shown first.
CellInNamedRange
Public Function CellInNamedRange(Rng As Range) As String
Dim N As Name
Dim C As Range
Dim TestRng As Range
On Error Resume Next
For Each N In ActiveWorkbook.Names
Set C = Nothing
Set TestRng = N.RefersToRange
Set C = Application.Intersect(TestRng, Rng)
If Not C Is Nothing Then
CellInNamedRange = N.Name
Exit Function
End If
Next N
CellInNamedRange = ""
End Function
SelectRange
Public Sub SelectRange()
Dim RngName As String
Dim R As Range
Set R = ActiveCell
Dim Msg As String
Msg = "Active Cell Is Not In A Named Range."
RngName = CellInNamedRange(R)
If RngName <> "" Then
Range(RngName).Select
Msg = "Range: " + RngName + " Selected."
End If
Application.StatusBar = Msg
End Sub
This macro requires the CellInNamedRange function, shown first.
CellInNamedRange
Public Function CellInNamedRange(Rng As Range) As String
Dim N As Name
Dim C As Range
Dim TestRng As Range
On Error Resume Next
For Each N In ActiveWorkbook.Names
Set C = Nothing
Set TestRng = N.RefersToRange
Set C = Application.Intersect(TestRng, Rng)
If Not C Is Nothing Then
CellInNamedRange = N.Name
Exit Function
End If
Next N
CellInNamedRange = ""
End Function
SelectRange
Public Sub SelectRange()
Dim RngName As String
Dim R As Range
Set R = ActiveCell
Dim Msg As String
Msg = "Active Cell Is Not In A Named Range."
RngName = CellInNamedRange(R)
If RngName <> "" Then
Range(RngName).Select
Msg = "Range: " + RngName + " Selected."
End If
Application.StatusBar = Msg
End Sub
No comments:
Post a Comment