CODEWITHSUNDEEP
excelvbadynamicrangenamed
Mr.Montreal
Mr.Montreal

Reputation: 31

Excel VBA - How to check if target is a named range. If yes, paste range

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**

Upvotes: 1

Views: 2455

Answers (3)

BigBen
BigBen

Reputation: 49998

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)
        On Error GoTo 0

        Application.EnableEvents = True
    End If
End sub

Upvotes: 0

Vityata
Vityata

Reputation: 43585

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

Upvotes: 1

Valon Miller
Valon Miller

Reputation: 1156

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

Upvotes: 0

Related Questions