Cell in named range

[Len Silva]

Is there a way to determine if a cell is part of one or more named ranges?
Thanks

[BadlySpelledBuoy]

One possible way would be to use VBA. The example code below will loop through the named ranges and see if the selected cell appears anywhere within a named range and will throw up a message box with the name of the range if it does.
You could change Selection to a specific range if that would work better. Not much info to go on...

Sub NamedRangeCheck()
    Dim n As Name
    
    For Each n In ThisWorkbook.Names
        If Not Intersect(n.RefersToRange, Selection) Is Nothing Then
            MsgBox n.Name
        End If
    Next
End Sub

BSB

[Greg M]

Hi there,

Take a look at the attached workbook and see if it does what you need. It uses the following code:

Option Explicit


Sub CheckCell()

    Dim vaRangeNames    As Variant
    Dim sCellAddress    As String
    Dim sRangeNames     As String
    Dim rActiveCell     As Range
    Dim iRangeNo        As Integer
    Dim wks             As Worksheet

    If TypeOf Selection Is Range Then

          If Selection.Cells.CountLarge = 1 Then

                vaRangeNames = Array("ptrRange_A", "ptrRange_B", "ptrRange_C")

                Set rActiveCell = ActiveCell
                Set wks = ActiveSheet
                sCellAddress = rActiveCell.Address(ColumnAbsolute:=False, _
                                                   RowAbsolute:=False)

                sRangeNames = vbNullString

                For iRangeNo = LBound(vaRangeNames) To UBound(vaRangeNames)

                    If Not Intersect(rActiveCell, _
                                     wks.Range(vaRangeNames(iRangeNo))) Is Nothing Then

                        sRangeNames = sRangeNames & vbLf & vbTab & vaRangeNames(iRangeNo)

                    End If

                Next iRangeNo

                If sRangeNames <> vbNullString Then

                      MsgBox "Cell " & sCellAddress & " intersects with the " & _
                             "following named range(s):" & vbLf & sRangeNames, _
                              vbInformation


                Else: MsgBox "Cell " & sCellAddress & " does not intersect with " & _
                             "any of the specified named ranges", vbInformation

                End If

          Else: MsgBox "Please select a single cell before using this feature", vbExclamation

          End If

    Else: MsgBox "Please select a cell before using this feature", vbExclamation

    End If

End Sub

The highlighted values may be altered to suit your requirements.


Hope this helps - please let me know how you get on.

Regards,

Greg M

[Greg M]

Hi again,

Following on from BSB's approach, the attached workbook will check for intersections with ALL of the named ranges contained in a workbook. It uses the following code:

Option Explicit


Sub CheckCell()

    Dim sCellAddress    As String
    Dim sRangeNames     As String
    Dim rActiveCell     As Range
    Dim wks             As Worksheet
    Dim nam             As Name

    If TypeOf Selection Is Range Then

          If Selection.Cells.CountLarge = 1 Then

                Set rActiveCell = ActiveCell
                Set wks = ActiveSheet
                sCellAddress = rActiveCell.Address(ColumnAbsolute:=False, _
                                                   RowAbsolute:=False)

                sRangeNames = vbNullString

                For Each nam In ThisWorkbook.Names

                    If Not Intersect(rActiveCell, _
                                     wks.Range(nam.RefersTo)) Is Nothing Then

                        sRangeNames = sRangeNames & vbLf & vbTab & nam.Name

                    End If

                Next nam

                If sRangeNames <> vbNullString Then

                      MsgBox "Cell " & sCellAddress & " intersects with the " & _
                             "following named range(s):" & vbLf & sRangeNames, _
                              vbInformation


                Else: MsgBox "Cell " & sCellAddress & " does not intersect with " & _
                             "any of the specified named ranges", vbInformation

                End If

          Else: MsgBox "Please select a single cell before using this feature", vbExclamation

          End If

    Else: MsgBox "Please select a cell before using this feature", vbExclamation

    End If

End Sub

Hope this helps,

Regards,

Greg M

[Len Silva]

Thank you all, I appreciate it.

[Greg M]

Hi again,

Many thanks for your feedback and also for the Reputation increase - much appreciated!

You're welcome - glad I was able to help.

Best regards,

Greg M