Public Sub SelectionEntirelyInNames()
Dim Message As String
Dim aName As Name
Dim NameRange As Range
Dim aRange As Range
On Error Resume Next
For Each aName In Names
Set NameRange = Nothing
Set NameRange = aName.RefersToRange
If Not NameRange Is Nothing Then
If NameRange.Parent.Name = ActiveSheet.Name Then
Set aRange = Intersect(Selection, NameRange)
If Not aRange Is Nothing Then
If Selection.Address = aRange.Address Then
Message = Message & aName.Name & vbCr
End If
End If
End If
End If
Next aName
If Message = "" Then
MsgBox "The selection is not entirely in any name"
Else
MsgBox Message
End If
End Sub