Executing Macro based on cell contents

**m_roussakis** · 09-26-2018, 02:28 PM

I'm trying to have it so when a specific cell is filled out with specific text it runs a specific macro. This macro populates a specific range of cells relative to the text cell (example cell A1)

so:

IF
A1="text1"
THEN
Execute 'Macro1' (which fills range C1:D5)

I also want to be able to set other possible text values to run other macros, example: text2 runs macro2, text3 runs macro3, etc.

In a nutshell:

If trigger text in A1 is typed, Macro will run and paste specific range of text in C1:D5

Now I need this to be relative, so if this same text is typed in A10, for example, the macro will now populate C10:D15

Or perhaps there's a way to do this without macros, as each of the desired "paste" items have named ranges.

Thanks!

**ImranBhatti** · 09-26-2018, 02:38 PM

WorkSheet_Change event should be used

**m_roussakis** · 09-26-2018, 02:43 PM

Can you elaborate? I'm not experienced with VBA at all.

**sintek** · 09-26-2018, 02:47 PM

This will give you an idea...
In Sheet Module...

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("A:A")) Is Nothing Then
        Application.EnableEvents = False
        If Target = "text1" Then
            Cells(Target.Row, 1).Offset(, 2).Resize(6, 2) = "Text1" 'Call macro1
        ElseIf Target = "text2" Then
            Cells(Target.Row, 1).Offset(, 2).Resize(6, 2) = "Text2" 'Call macro2
        ElseIf Target = "text3" Then
            Cells(Target.Row, 1).Offset(, 2).Resize(6, 2) = "Text3" 'Call macro3
        End If
    End If
    Application.EnableEvents = True
End Sub

**m_roussakis** · 09-26-2018, 03:33 PM

I played around with this...

Problem is that I can't see where the macro is called?

Cells(Target.Row, 1).Offset(, 2).Resize(6, 2) = "Macro1" 'Call macro1

If I type "Macro1" where you say to call the macro, it just fills in the word "macro1" in the offset range....

**m_roussakis** · 09-26-2018, 03:40 PM

perhaps there's a way to call a named range rather than a macro?

so in other words, when column A finds specific text string, offset 2 columns to the right, and paste "named range XXX"

is this possible?

**sintek** · 09-26-2018, 03:43 PM

This was just an example...
I have no idea what your macro must do...The Call macro indicates to the code to run Macro1 which will be found in a std Module
i.e

This line normally will be changed to Call macro1

Cells(Target.Row, 1).Offset(, 2).Resize(6, 2) = "Text1"

and in a std Module

Sub Macro1()
   'Do something
End sub

Perhaps you should upload a sample file depicting your requirement...

**m_roussakis** · 09-26-2018, 04:01 PM

I attached a sample.
see sheet called "named ranges" also.

**sintek** · 09-26-2018, 04:13 PM

Have not set your named ranges...

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("A:A")) Is Nothing Then
        Application.EnableEvents = False
        If Target = "text1" Then
            Cells(Target.Row, 1).Offset(, 2).Resize(6, 12) = Sheet2.Range("A5:L10").Value
        ElseIf Target = "text2" Then
            Cells(Target.Row, 1).Offset(, 2).Resize(6, 12) = Sheet2.Range("A13:L18").Value
        ElseIf Target = "text3" Then
            Cells(Target.Row, 1).Offset(, 2).Resize(6, 12) = Sheet2.Range("A21:L26").Value
        End If
    End If
    Application.EnableEvents = True
End Sub

**m_roussakis** · 09-26-2018, 04:25 PM

Pasted this code into Sheet1

I renamed my sheet containing the ranges to match what you gave me (Sheet2).

It's not working. When I type 'text1' in column A on Sheet1, nothing appears at the offset you indicated.

**m_roussakis** · 09-26-2018, 04:40 PM

I've added your code, and as you can see from attached, doesn't seem to be working. any ideas? thx . where did i mess up? :p

**sintek** · 09-27-2018, 12:34 AM

Works fine for me...
Untitled.png

**m_roussakis** · 09-27-2018, 10:01 AM

I reloaded the example sheet and it worked. However when I applied this to my actual document, I get a script error.

Here's the details of my actual document:

- I have many named ranges, all the same size of 8 rows x 13 columns
- If it matters (which I don't think it does) the named ranges are all on sheet "Components"
- The trigger string would be anywhere in column B within sheet "Sheet2"
- I need the named range to be inserted at offset of (-1, 1) from the trigger string cell.
- I need the inserted named range to retain all properties (colors, dynamic dropdowns, font, etc)

I have a feeling that a cut and paste macro may be additionally needed here.

Here's my code right now. Obviously it has issues....

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("B:B")) Is Nothing Then
        Application.EnableEvents = False
        If Target = "Crew_Key_Non_Prompt" Then
            Cells(Target.Row, 1).Offset(-1, 1).Resize(8, 13) = Components.Range(***HOW CAN I SPECIFY A NAMED RANGE HERE***).Value
        ElseIf Target = "Crew_Key_Prompt" Then
            Cells(Target.Row, 1).Offset(-1, 1).Resize(8, 13) = Components.Range(***HOW CAN I SPECIFY A NAMED RANGE HERE***).Value
        ElseIf Target = "Crew_Key_Target" Then
            Cells(Target.Row, 1).Offset(-1, 1).Resize(8, 13) = Components.Range(***HOW CAN I SPECIFY A NAMED RANGE HERE***).Value
        End If
    End If
    Application.EnableEvents = True
End Sub

Thanks

**sintek** · 09-27-2018, 10:27 AM

In future please view the forum rules before posting. Your post does not comply with rule #2.

2. Programming code must be enclosed in code tags to improve readability. (A, Z)

 Your Code

So, do the following:
Edit your post, highlight your code and click the [#] button at the top of the post window.

**m_roussakis** · 09-27-2018, 10:39 AM

done. thx for letting me know.

**sintek** · 09-27-2018, 10:56 AM

Look at the attached...I created the named ranges as Range1, Range2, Range3

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("A:A")) Is Nothing Then
        Application.EnableEvents = False
        If Target = "text1" Then
            Sheet2.Range("Range1").Copy
            Cells(Target.Row, 1).Offset(, 2).Resize(6, 12).PasteSpecial xlPasteAll
        ElseIf Target = "text2" Then
            Sheet2.Range("Range2").Copy
            Cells(Target.Row, 1).Offset(, 2).Resize(6, 12).PasteSpecial xlPasteAll
        ElseIf Target = "text3" Then
            Sheet2.Range("Range3").Copy
            Cells(Target.Row, 1).Offset(, 2).Resize(6, 12).PasteSpecial xlPasteAll
        End If
    End If
    Application.EnableEvents = True
    Application.CutCopyMode = False
End Sub

**m_roussakis** · 09-27-2018, 02:05 PM

Still having difficulties

Pls tell me if I understand your code:

Where I have written "Components" in bold, does this mean the sheet where the named ranges reside? If so, I am getting an error on this . See below for screenshot. I have only edited the code for one text string/named range combo: Crew_Key_Target, so pls ignore the other 2 text strings.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("B:B")) Is Nothing Then
        Application.EnableEvents = False
        If Target = "Crew_Key_Target" Then
            Components.Range("Crew_Key_Target").Copy
            Cells(Target.Row, 1).Offset(-1, 1).Resize(8, 13).PasteSpecial xlPasteAll
        ElseIf Target = "text2" Then
            Sheet2.Range("Range2").Copy
            Cells(Target.Row, 1).Offset(, 2).Resize(6, 12).PasteSpecial xlPasteAll
        ElseIf Target = "text3" Then
            Sheet2.Range("Range3").Copy
            Cells(Target.Row, 1).Offset(, 2).Resize(6, 12).PasteSpecial xlPasteAll
        End If
    End If
    Application.EnableEvents = True
    Application.CutCopyMode = False
End Sub

See image:
Capture.PNG

**sintek** · 09-27-2018, 02:13 PM

Sheets("Conponents")...
Not in front of pc.. Upload your fule or we going to go back and forth forever...

**m_roussakis** · 09-27-2018, 02:11 PM

wow i realized that the proper names I give sheets are not what is to be referred to in code. I should have used Sheet1.... in any case ignore last comment. I'll test it out now.

**m_roussakis** · 09-27-2018, 02:31 PM

no worries. I got it working perfectly! thanks!!

**sintek** · 09-27-2018, 02:59 PM

Please mark thread as solved ...
Thank you for adding rep +

**m_roussakis** · 09-27-2018, 05:01 PM

....solved however I have a new issue.

If I try to add new rows anywhere I get a run-time error. I tried it on the example you sent me, and it's happens there too. Any ideas why?

Screenshot from your example:
Capture.PNG

Here's my code:

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).Resize(8, 13).PasteSpecial xlPasteAll
        ElseIf Target = "Crew_Key_Prompt" Then
            Sheet1.Range("Crew_Key_Prompt").Copy
            Cells(Target.Row, 1).Offset(-1, 2).Resize(8, 13).PasteSpecial xlPasteAll
        ElseIf Target = "Crew_Key_Target" Then
            Sheet1.Range("Crew_Key_Target").Copy
            Cells(Target.Row, 1).Offset(-1, 2).Resize(8, 13).PasteSpecial xlPasteAll
        ElseIf Target = "Crew_Speed" Then
            Sheet1.Range("Crew_Speed").Copy
            Cells(Target.Row, 1).Offset(-1, 2).Resize(8, 13).PasteSpecial xlPasteAll
        ElseIf Target = "Crew_Speed_Overspeed" Then
            Sheet1.Range("Crew_Speed_Overspeed").Copy
            Cells(Target.Row, 1).Offset(-1, 2).Resize(8, 13).PasteSpecial xlPasteAll
        ElseIf Target = "Crew_Train_Orientation" Then
            Sheet1.Range("Crew_Train_Orientation").Copy
            Cells(Target.Row, 1).Offset(-1, 2).Resize(8, 13).PasteSpecial xlPasteAll
        ElseIf Target = "Crew_Verbal_Confirmation" Then
            Sheet1.Range("Crew_Verbal_Confirmation").Copy
            Cells(Target.Row, 1).Offset(-1, 2).Resize(8, 13).PasteSpecial xlPasteAll
        ElseIf Target = "Dispatcher_Action" Then
            Sheet1.Range("Dispatcher_Action_button").Copy
            Cells(Target.Row, 1).Offset(-1, 2).Resize(8, 13).PasteSpecial xlPasteAll
        ElseIf Target = "Fence_Validation" Then
            Sheet1.Range("Fence_Validation").Copy
            Cells(Target.Row, 1).Offset(-1, 2).Resize(8, 13).PasteSpecial xlPasteAll
        ElseIf Target = "Fence_Validation" Then
            Sheet1.Range("Fence_Validation").Copy
            Cells(Target.Row, 1).Offset(-1, 2).Resize(8, 13).PasteSpecial xlPasteAll
        ElseIf Target = "Set_Device" Then
            Sheet1.Range("Set_Device").Copy
            Cells(Target.Row, 1).Offset(-1, 2).Resize(8, 13).PasteSpecial xlPasteAll
        ElseIf Target = "Train_Switch_Navigation" Then
            Sheet1.Range("Train_Switch_Navigation").Copy
            Cells(Target.Row, 1).Offset(-1, 2).Resize(8, 13).PasteSpecial xlPasteAll
        ElseIf Target = "Train_Target_Approach" Then
            Sheet1.Range("Train_Target_Approach").Copy
            Cells(Target.Row, 1).Offset(-1, 2).Resize(8, 13).PasteSpecial xlPasteAll
        ElseIf Target = "Train_Target_Interaction" Then
            Sheet1.Range("Train_Target_Interaction").Copy
            Cells(Target.Row, 1).Offset(-1, 2).Resize(8, 13).PasteSpecial xlPasteAll
        ElseIf Target = "Train_Timed_Movement" Then
            Sheet1.Range("Train_Timed_Movement").Copy
            Cells(Target.Row, 1).Offset(-1, 2).Resize(8, 13).PasteSpecial xlPasteAll
        End If
    End If
    Application.EnableEvents = True
    Application.CutCopyMode = False
End Sub

Thx for your patience.

**sintek** · 09-28-2018, 01:00 AM

Remove this part in all the code...it ids not necessary when pasting...Forgot to remove it when I changed code earlier...

.Resize(8, 13)

**m_roussakis** · 09-28-2018, 09:10 AM

I removed those lines in my code. Still getting error if adding new rows.

**sintek** · 09-28-2018, 09:12 AM

can't say without your workbook upload...Are you adding new rows to the named ranges or what

**m_roussakis** · 09-28-2018, 09:33 AM

no i'm adding rows withing the sheet. I'm not touching the ranges.

i've attached a version of my sheet.

thx.

Hybrid View

Executing Macro based on cell contents

Re: Executing Macro based on cell contents

Re: Executing Macro based on cell contents

Re: Executing Macro based on cell contents

Re: Executing Macro based on cell contents

Re: Executing Macro based on cell contents

Re: Executing Macro based on cell contents

Re: Executing Macro based on cell contents

Re: Executing Macro based on cell contents

Re: Executing Macro based on cell contents

Re: Executing Macro based on cell contents

Re: Executing Macro based on cell contents

Re: Executing Macro based on cell contents

Re: Executing Macro based on cell contents

Re: Executing Macro based on cell contents

Re: Executing Macro based on cell contents

Re: Executing Macro based on cell contents

Re: Executing Macro based on cell contents

Re: Executing Macro based on cell contents

Re: Executing Macro based on cell contents

Re: Executing Macro based on cell contents

Re: Executing Macro based on cell contents

Re: Executing Macro based on cell contents

Re: Executing Macro based on cell contents

Re: Executing Macro based on cell contents

Thread Information

Users Browsing this Thread

Similar Threads

[SOLVED] Need help writing macro to replace one cell based on contents of adjacent cell

Bookmarks

Bookmarks

Posting Permissions