I currently have my excel coded to do the following:

Whenever various specific text strings are typed anywhere in column B, a corresponding named range will be pasted at a relative offset.

Instead of typing each trigger term and corresponding named range in the code.....is there a way to instead have it dynamic?

IF target = "ANY named range" THEN paste the named range

Here's snippet of current code. My eventual named range list will be growing, so this method is not going to be feasible when the named range list gets too big. It'll be a pain to maintain, hence my request here:

**Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("B:B")) Is Nothing Then
    Application.EnableEvents = True
    If Target = "Crew_Key_Non_Prompt" Then
        Sheet1.Range("Crew_Key_Non_Prompt").Copy
        Cells(Target.Row, 1).Offset(-1, 2).PasteSpecial xlPasteAll
    ElseIf Target = "Crew_Key_Prompt" Then
        Sheet1.Range("Crew_Key_Prompt").Copy
        Cells(Target.Row, 1).Offset(-1, 2).PasteSpecial xlPasteAll
    ElseIf Target = "Crew_Key_Target" Then
        Sheet1.Range("Crew_Key_Target").Copy
        Cells(Target.Row, 1).Offset(-1, 2).PasteSpecial xlPasteAll
    ElseIf Target = "Crew_Speed" Then
        Sheet1.Range("Crew_Speed").Copy
        Cells(Target.Row, 1).Offset(-1, 2).PasteSpecial xlPasteAll
    ElseIf Target = "Crew_Speed_Overspeed" Then
        Sheet1.Range("Crew_Speed_Overspeed").Copy
        Cells(Target.Row, 1).Offset(-1, 2).PasteSpecial xlPasteAll
    ElseIf Target = "Crew_Train_Orientation" Then
        Sheet1.Range("Crew_Train_Orientation").Copy
        Cells(Target.Row, 1).Offset(-1, 2).PasteSpecial xlPasteAll
    ElseIf Target = "Crew_Verbal_Confirmation" Then
        Sheet1.Range("Crew_Verbal_Confirmation").Copy
        Cells(Target.Row, 1).Offset(-1, 2).PasteSpecial xlPasteAll
    ElseIf Target = "Dispatcher_Action" Then
        Sheet1.Range("Dispatcher_Action_button").Copy
        Cells(Target.Row, 1).Offset(-1, 2).PasteSpecial xlPasteAll
    ElseIf Target = "Fence_Validation" Then
        Sheet1.Range("Fence_Validation").Copy
        Cells(Target.Row, 1).Offset(-1, 2).PasteSpecial xlPasteAll
    ElseIf Target = "Fence_Validation" Then
        Sheet1.Range("Fence_Validation").Copy
        Cells(Target.Row, 1).Offset(-1, 2).PasteSpecial xlPasteAll
    ElseIf Target = "Set_Device" Then
        Sheet1.Range("Set_Device").Copy
        Cells(Target.Row, 1).Offset(-1, 2).PasteSpecial xlPasteAll
    ElseIf Target = "Train_Switch_Navigation" Then
        Sheet1.Range("Train_Switch_Navigation").Copy
        Cells(Target.Row, 1).Offset(-1, 2).PasteSpecial xlPasteAll
    ElseIf Target = "Train_Target_Approach" Then
        Sheet1.Range("Train_Target_Approach").Copy
        Cells(Target.Row, 1).Offset(-1, 2).PasteSpecial xlPasteAll
    ElseIf Target = "Train_Target_Interaction" Then
        Sheet1.Range("Train_Target_Interaction").Copy
        Cells(Target.Row, 1).Offset(-1, 2).PasteSpecial xlPasteAll
    ElseIf Target = "Train_Timed_Movement" Then
        Sheet1.Range("Train_Timed_Movement").Copy
        Cells(Target.Row, 1).Offset(-1, 2).PasteSpecial xlPasteAll
        End If
     End If
  Application.EnableEvents = True
  Application.CutCopyMode = False
 End Sub**
New contributor
user10429816 is a new contributor to this site. Take care in asking for clarification, commenting, and answering. Check out our Code of Conduct.
  • 2
    You could use ThisWorkbook.Names to loop through named ranges in your workbook. When you find one, perform your action and exit the loop – Zac 1 hour ago
  • You could easily repurpose this, i think stackoverflow.com/a/41449283/2727437 – Marcucciboy2 56 mins ago
up vote 0 down vote accepted

While the use of On Error Resume Next is generally discouraged, this could be an exception. If there is no named range on Sheet1 corresponding to the value entered in Target, no copy/paste occurs.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Me.Range("B:B")) Is Nothing Then
        Application.EnableEvents = False

        On Error Resume Next
        Sheet1.Range(Target.Value).Copy Target.Offset(-1,1)

        Application.EnableEvents = True
    End If
End sub
  • What happens if Target.Value is not a named range? – Zac 15 mins ago
  • Nothing happens at all because of the On Error Resume Next. Which is 100% equivalent to what OP currently has - if there is no named range, nothing gets copied and pasted. – BigBen 14 mins ago
  • Good shout but you might want to reset it back to On Error Goto 0 – Zac 12 mins ago
  • 1
    No need to. Events get enabled with the next line and execution ends. – BigBen 11 mins ago
  • Again, good shout! – Zac 9 mins ago

Some function like this is probably viable:

Public Function amInamedRange(myName As String, ws As Worksheet) As Boolean

    On Error GoTo amInamedRange_Error

    If ws.Range(myName) <> "" Then
    End If
    amInamedRange = True

    On Error GoTo 0
    Exit Function

amInamedRange_Error:
    amInamedRange = False
    On Error GoTo 0

End Function

And here is some possible usage:

Private Sub Worksheet_Change(ByVal Target As Range)

    If Not Intersect(Target, Range("B:B")) Is Nothing Then
        Application.EnableEvents = False
        If amInamedRange(Target.Value2, Target.Parent) Then
            Sheet1.Range(target).Copy
            Cells(Target.Row, 1).Offset(-1, 2).PasteSpecial xlPasteAll
            Application.CutCopyMode = False
        End If
        Application.EnableEvents = True
    End If

End Sub
  • 1
    Thanks. I replaced my code with yours and I get a Compile error: ByRef argument type mismatch.... – user10429816 18 mins ago
  • 1
    I think you are missing ws when calling amInamedRange UDF. Also, you are sending in a range when expecting a string – Zac 17 mins ago
  • @Zac - yeah, this time the error description is 100% correct. – Vityata 16 mins ago
  • @user10429816 - give it a try again. – Vityata 15 mins ago
  • 1
    @Vityata: exactly right. I have fallen into that trap in the past – Zac 5 mins ago

If the named ranges are single cells or formulas, then something like this would work:

Private Function getValueFromNamedRange(strName As String, Optional wb As Workbook) As Variant
    'Locally scoped names must include "<sheetName>!"
    Dim n As Name
    On Error GoTo uhoh
    If wb Is Nothing Then Set wb = ThisWorkbook
    For Each n In wb.Names
        If n.Name = strName Then getValueFromNamedRange = Evaluate(n.RefersTo): Exit Function
    Next
uhoh:
    getValueFromNamedRange = ""
End Function

Sub test()
    Dim s As String
    s = getValueFromNamedRange("TEST")
    If s <> "" Then MsgBox s
End Sub

Your Answer

user10429816 is a new contributor. Be nice, and check out our Code of Conduct.
 

By clicking "Post Your Answer", you acknowledge that you have read our updated terms of service, privacy policy and cookie policy, and that your continued use of the website is subject to these policies.

Not the answer you're looking for? Browse other questions tagged or ask your own question.