Getting Defined Name from Cell

[Excel User]

Hi,

I have a row which contain a series of named ranges (atype1, atype2, atype3
...... ztype1, ztype2, ztype3)

What I trying to do is depending on the activecell name (actually the type
part of the name typea, typeb, typc) run a function, e.g.

if the activecell name = "type1" then run functiona,
if the activecell name = "type2" then run functionb etc


Is it possible to use the

If Target.Address = "$A$100" Then

If activecell name = "type1" then run functiona
etc
End If

End If


I tried using the activecell.range.name but this does not work?

Any help is appreciated

 

[Dave Peterson]

Option Explicit
Sub testme()

Dim myStr As String
myStr = ""
On Error Resume Next
myStr = ActiveCell.Name.Name
On Error GoTo 0

If LCase(myStr) Like LCase("?type*") Then
Select Case LCase(Mid(myStr, 2))
Case Is = "type1": Call SubA
Case Is = "type2": Call SubB
End Select
End If

End Sub

Sub SubA()
MsgBox "suba"
End Sub

Sub SubB()
MsgBox "subb"
End Sub

 

[Excel User]

Thanks Dave for the quick reply that works great!

 

[Excel User]

Dave,

Just a quick question, I have changed the defined name so that type1 refers
to

=OSR!$BW$39,OSR!$CC$39,OSR!$CI$39,OSR!$CO$39,OSR!$CU$39,OSR!$DA$39,OSR!$DG$39,OSR!$DM$39

but now the named range does not pickup, I think this must be because this
is a range not a cell - any ideas, I can if need change this but its going
to be time consuming to go through all 600 cells changing the names

Thanks

 

[JE McGimpsey]

ONe way:

Public Sub test()
Dim nmTest As Name
Dim rTest As Range
Dim sName As String

For Each nmTest In ActiveWorkbook.Names
With nmTest
On Error Resume Next
Set rTest = .RefersToRange
On Error GoTo 0
If Not rTest Is Nothing Then
If Not Intersect(rTest, ActiveCell) Is Nothing Then
sName = LCase(Mid(.Name, 2))
Exit For
End If
End If
End With
Set rTest = Nothing
Next nmTest
If Not sName = vbNullString Then
Select Case sName
Case Is = "type1": Call SubA
Case Is = "type2": Call SubB
Case Else: 'Do nothing
End Select
End If
End Sub

 

[Excel User]

Thanks,

But the range name picked up is the 'Print Area' not the actual named
range - strange?

Any ideas?

 

[Dave Peterson]

You could look for the "type" string in the name:

Option Explicit
Public Sub test()
Dim nmTest As Name
Dim rTest As Range
Dim sName As String

For Each nmTest In ActiveWorkbook.Names
With nmTest
If LCase(nmTest.Name) Like "*type*" Then
Set rTest = Nothing
On Error Resume Next
Set rTest = .RefersToRange
On Error GoTo 0
If Not rTest Is Nothing Then
If Not Intersect(rTest, ActiveCell) Is Nothing Then
sName = LCase(Mid(.Name, 2))
Exit For
End If
End If
End If
End With
Next nmTest

If Not sName = vbNullString Then
Select Case sName
Case Is = "type1": Call SubA
Case Is = "type2": Call SubB
Case Else: 'Do nothing
End Select
End If
End Sub

Sub SubA()
MsgBox "suba"
End Sub

Sub SubB()
MsgBox "subb"
End Sub

 

[Excel User]

Dave,

That's perfect - thanks again!

You could look for the "type" string in the name:

Option Explicit
Public Sub test()
Dim nmTest As Name
Dim rTest As Range
Dim sName As String

For Each nmTest In ActiveWorkbook.Names
With nmTest
If LCase(nmTest.Name) Like "*type*" Then
Set rTest = Nothing
On Error Resume Next
Set rTest = .RefersToRange
On Error GoTo 0
If Not rTest Is Nothing Then
If Not Intersect(rTest, ActiveCell) Is Nothing Then
sName = LCase(Mid(.Name, 2))
Exit For
End If
End If
End If
End With
Next nmTest

If Not sName = vbNullString Then
Select Case sName
Case Is = "type1": Call SubA
Case Is = "type2": Call SubB
Case Else: 'Do nothing
End Select
End If
End Sub

Sub SubA()
MsgBox "suba"
End Sub

Sub SubB()
MsgBox "subb"
End Sub