Show the defined name of cells, help with modification of this UDF

B

Bol

Function myname(rng)
Set nms = ActiveWorkbook.Names
myname = "BLANK"
For r = 1 To nms.Count
If rng = nms(r).RefersToRange.Address Then
myname = nms(r).Name
End If
Next
End Function

I have already got this UDF from Bernard Liengme (thank you). It will show
the user defined name of a cell. The problem is that you have to include the
""-signs and a absolute addresss when you use this UDF, like:

=MYNAME("$A$11") will return ABC if ABC is the defined name of cell A11.

The problem is that the "<absolute address>" in the MYNAME-function, is not
supported by Excel's AutoFill-function which is very important for me. I'm
not able to program this myself, but perhaps anybody here could modify this
code so that you don't have to include the ""-notation and the absolute
address: =MYNAME(A11) instead of =MYNAME("$A$11").

Please help!
 
B

Bob Phillips

Bol,

Try this version. You need to pass a range object, relative/absolute/mixedl,
or a cell string

Function myname(rng)
Dim nms As Names
Dim nme As Name
Dim rngTest As Range
Dim rngRefersto As Range
Dim r As Long

If TypeOf rng Is Range Then
Set rngTest = rng
ElseIf Not IsNumeric(rng) Then
Set rngTest = Range(rng)
Else
myname = CVErr(xlErrValue)
Exit Function
End If

Set nms = ActiveWorkbook.Names
myname = "BLANK"
For r = 1 To nms.Count
Set nme = nms(r)
Set rngRefersto = Nothing
On Error Resume Next
Set rngRefersto = Range(nme.RefersTo)
On Error GoTo 0
If Not rngRefersto Is Nothing Then
If rngRefersto.Address = nms(r).RefersToRange.Address Or _
Not Union(rngTest, rngRefersto) Is Nothing Then
myname = nme.Name
Exit For
End If
End If
Next
End Function


--
HTH

Bob Phillips

(remove nothere from email address if mailing direct)
 
B

Bol

Hi and thanks for your answer.

I got a problem with your UDF. It works for the first cell ,i.e =MYNAME(B1),
gives you the name of B1. When I use the AutoFill-function the next cell
gets the content =MYNAME(B2), but still the name of cell B1 is given out.

Please help!


Bob Phillips skrev:
 
B

Bob Phillips

Sorry Bol, I used Union not Intersect

Function myname(rng)
Dim nms As Names
Dim nme As Name
Dim rngTest As Range
Dim rngRefersto As Range
Dim r As Long

If TypeOf rng Is Range Then
Set rngTest = rng
ElseIf Not IsNumeric(rng) Then
Set rngTest = Range(rng)
Else
myname = CVErr(xlErrValue)
Exit Function
End If

Set nms = ActiveWorkbook.Names
myname = "BLANK"
For r = 1 To nms.Count
Set nme = nms(r)
Set rngRefersto = Nothing
On Error Resume Next
Set rngRefersto = Range(nme.RefersTo)
On Error GoTo 0
If Not rngRefersto Is Nothing Then
If Not Intersect(rngTest, rngRefersto) Is Nothing Then
myname = nme.Name
Exit For
End If
End If
Next
End Function


--
HTH

Bob Phillips

(remove nothere from email address if mailing direct)
 
B

Bol

Hi!

That did not solve the problem. Seems like there is an error in the UDF code.

Bol
 
Top