Option Explicit 
Option Compare Text 
 
Public Function NAMEDRANGE(celRef As Variant) As String 
     
     'Declare variables
    Dim iName As Name, wbCall As Workbook, blnApprox As Boolean 
    Dim NRange As String 
    On Error Resume Next 
     'Check if celRef is a Range
    If TypeOf celRef Is Range Then 
        celRef = celRef.Address 
    End If 
    If Not celRef Like "*!$" Then 
        celRef = Application.Caller.Parent.Name & "!" & celRef 
        If Err = 424 Then celRef = Range(celRef).Parent.Name & "!" & celRef 
        Err.Clear 
    End If 
     
     'Set function caller (dynamic)
    Set wbCall = Workbooks(Application.Caller.Parent.Parent.Name) 
     
     'If called from VBA, then ..
    If Err = 424 Then Set wbCall = ActiveWorkbook 
    On Error GoTo 0 
     
     'Loop through all names in workbook
    For Each iName In wbCall.Names 
         
         'If name matches specified parameter
        If iName.RefersTo = "=" & celRef Then 
             'Exact match
            NAMEDRANGE = iName.Name 
            Set wbCall = Nothing 
            Exit Function 
        ElseIf Not Intersect(Range(celRef), Range(iName.RefersTo)) Is Nothing Then 
             'Checks for range being anywhere in any intersect in any named range
            NRange = NRange & "'" & iName.Name & "', " 
            NAMEDRANGE = "Intersects " & Left(NRange, Len(NRange) - 2) 
            blnApprox = True 
        End If 
         
    Next 
     
Err_Exit: 
     
     'If not found, mark it and release variable.
    If Not blnApprox Then NAMEDRANGE = "Not Found" 
    Set wbCall = Nothing 
     
End Function 
 
Sub CalledFromVBAx1() 
     'Example 1
    MsgBox NAMEDRANGE("$A$1") 
End Sub 
 
Sub CalledFromVBAx2() 
     'Example 2
    MsgBox NAMEDRANGE(Range("$A$1:$B$2")) 
End Sub 
 
Sub CalledFromVBAx3() 
     'Example 3
    MsgBox NAMEDRANGE("$A$1:$C$3") 
End Sub