Cell in named range

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