Run a Worksheet change macro on two sheets

**neilshaw2** · 10-09-2011, 06:04 PM

Hello there.

I have a worksheet change macro that will insert a picture when cell D5 is edited. My problem is that although I have it working on the sheet called "INVITE" I would like to be able to get the macro working on other sheets in the book. Is anyone able to assist per chance?

Public ws As Variant

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim rng As Range
    Dim OutApp As Object
    Dim OutMail As Object

If Target.Address = "$D$5" Then

    'paste letter signatory
    Signatory = Target.Value

    Set ws = ThisWorkbook.Worksheets("INVITE")
    ws.DrawingObjects.Delete
    
    Search_Str = "Yours sincerely"
    Set rnge = ws.Columns(1).Find(Search_Str, LookIn:=xlValues)
    
    If Not rnge Is Nothing Then
        'Search_Str found insert picture according to where found then move down accordingly
        InsertPic "T:\Scheme Details\Signatures\" & Signatory & ".JPG", _
            ws.Range(rnge.Address), False, True
    Else
        'no instances of Search_Str
        MsgBox "Unable to locate salutation on the '" & ws.Name & "' worksheet." & Chr(13) & Chr(13) & "As a result no signature has been inserted within this worksheet.", vbOKOnly + vbInformation, "NO SALUTATION FOUND"
        
    End If
End Sub

I look forward to hearing from you

Neil Shaw

**TMShucks** · 10-09-2011, 06:09 PM

I suspect that changing:

    Set ws = ThisWorkbook.Worksheets("INVITE")

to:

    Set ws = ActiveSheet

would generalise the code for you.

Regards

**neilshaw2** · 10-09-2011, 06:14 PM

thanks for your reply.

Is there any way that I could perhaps list the sheets that I want the code working on? The code above will be on a separate worksheet to where the picture is inserted you see. so ideally i would like to be able to define a few sheets that this code is executed on...

**TMShucks** · 10-09-2011, 07:06 PM

A Worksheet_Change event applies to the sheet in which the code resides. You can copy and paste the code into the sheets to which it is relevant.

The alternative, if you only want one copy of the code, which is a not unreasonable requirement, is to have the code in the Workbook_SheetChange event. You could then test the ActiveSheet.Name to determine if the code applies to the sheet being processed.

Regards

**royUK** · 10-10-2011, 02:30 AM

You could put the main code into a seperate module - AddSignature

Option Explicit

Private AddSignature

    Dim rng As Range
    Dim OutApp As Object
    Dim OutMail As Object

    'paste letter signatory
    Signatory = Target.Value

    Set ws = ActiveSheet
    ws.DrawingObjects.Delete
    
    Search_Str = "Yours sincerely"
    Set rnge = ws.Columns(1).Find(Search_Str, LookIn:=xlValues)
    
    If Not rnge Is Nothing Then
        'Search_Str found insert picture according to where found then move down accordingly
        InsertPic "T:\Scheme Details\Signatures\" & Signatory & ".JPG", _
            ws.Range(rnge.Address), False, True
    Else
        'no instances of Search_Str
        MsgBox "Unable to locate salutation on the '" & ws.Name & "' worksheet." & Chr(13) & Chr(13) & "As a result no signature has been inserted within this worksheet.", vbOKOnly + vbInformation, "NO SALUTATION FOUND"
        
    End If
End Sub

Then use the Workbook SheetChange event

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Select Case Sh.Name
    Case "A", "B", "C"    '<list sheets for signing here
        if Target.address="$D$5$ then addsignature
    Case Else: Exit Sub
    End Select
End Sub

Workbook Event code should be added to the workbook code module:

Copy the Excel VBA code that you want to use
Select the workbook in which you want to store the code
Hold the Alt key, and press the F11 key, to open the Visual Basic Editor
In the Project Explorer, find your workbook, and open the list of Microsoft Excel Objects
Right-click on the ThisWorkbook object, and choose View Code
Where the cursor is flashing, choose Edit | Paste

**neilshaw2** · 10-10-2011, 04:28 AM

Hi Roy,

Thank you so much for the suggestion, I think this seems like a very logical approach.

Unfortunately I seem to be getting a compile error on the Workbook_SheetChange module.

The line that is in red is

If Target.Address="$D$5$ Then addsignature

The error:-

"Compile error:
Expected: Then or GoTo"

Any idea how to resolve this?

Neil

**royUK** · 10-10-2011, 05:32 AM

can you attach the workbook

**neilshaw2** · 10-10-2011, 06:02 AM

Unfortunately I am unable to upload currently, either my server is not working or the forum server upload function is not working. I may be able to try later.

**royUK** · 10-10-2011, 06:03 AM

Just spotted typo, should be

Option Explicit


Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
 If Target.Address = "$D$5" Then
Select Case Sh.Name
    Case "A", "B", "C"    '<list sheets for signing here
        AddSignature
    Case Else: Exit Sub
    End Select
    End If
End Sub

Check your add signature because the variable names do not match your declared names

Option Explicit


 Sub AddSignature()
    Dim ws As Worksheet
    Dim rRng As Range
    Dim Signatory As String
    Dim Search_Str As String
'    Dim OutApp As Object
'    Dim OutMail As Object
    'paste letter signatory
    Signatory = ActiveCell.Value
    
    Set ws = ActiveSheet
    ws.DrawingObjects.Delete

    Search_Str = "Yours sincerely"
    Set rRng = ws.Columns(1).Find(Search_Str, LookIn:=xlValues)

    If Not rRng Is Nothing Then
        'Search_Str found insert picture according to where found then move down accordingly
        InsertPic "T:\Scheme Details\Signatures\" & Signatory & ".JPG", _
            ws.Range(rRng.Address), False, True
    Else
        'no instances of Search_Str
        MsgBox "Unable to locate salutation on the '" & ws.Name & "' worksheet." & Chr(13) & Chr(13) & "As a result no signature has been inserted within this worksheet.", vbOKOnly + vbInformation, "NO SALUTATION FOUND"

    End If

End Sub

**neilshaw2** · 10-10-2011, 06:28 AM

It doesn't appear to be working...

If I explain a little more, perhaps this will help, if not then I can email the sheet over?

1. The worksheet change event is triggered by cell D5 on a sheet called "INPUT"
2. Once the criteria has been selected in this cell, the worksheet change event inside "INPUT" calls a macro to include a JPG image on another sheet called "INVITE" which uses another piece of code to place the image on the invite letter.
3. I now also need to reference a number of other sheets e.g "INVITE 2", "INVITE 3" and include the JPG on them too.

**royUK** · 10-10-2011, 06:42 AM

If that's the case then you don't need the workbook code, but use the Input sheet change event.

You can't use the invite's events unless the sheet is active

**neilshaw2** · 10-10-2011, 07:16 AM

Unfortunately I cannot get it to work. Would you be able to Inbox your email please so I can send this sheet to you?

**royUK** · 10-10-2011, 07:53 AM

Sorry I'm at work but you can attach it later perhaps from home

**neilshaw2** · 10-11-2011, 04:09 AM

I have finally solved it.

all that I have done is defined the sheets at the start (see the section with Set ws1 etc):-

   

If Target.Address = "$D$5" Then

    'paste letter signatory
    Signatory = Target.Value
    
    
    Set ws1 = ThisWorkbook.Worksheets("INVITE")
    Set ws2 = ThisWorkbook.Worksheets("INVITE SOM")
    For Each ws In Array(ws1, ws2)
        
        'Set ws = ThisWorkbook.Worksheets("INVITE")
        ws.DrawingObjects.Delete
        
        Search_Str = "Yours sincerely"
        Set rnge = ws.Columns(1).Find(Search_Str, LookIn:=xlValues)
        
        If Not rnge Is Nothing Then
            'Search_Str found insert picture according to where found then move down accordingly
            InsertPic "T:\Scheme Details\Signatures\" & Signatory & ".JPG", _
                ws.Range(rnge.Address), False, True
        Else
            'no instances of Search_Str
            MsgBox "Unable to locate salutation on the '" & ws.Name & "' worksheet." & Chr(13) & Chr(13) & "As a result no signature has been inserted within this worksheet.", vbOKOnly + vbInformation, "NO SALUTATION FOUND"
            
        End If

Thanks for your help.

Neil

Thread: Run a Worksheet change macro on two sheets

Thread Tools

Display

Run a Worksheet change macro on two sheets

Re: Run a Worksheet change macro on two sheets

Re: Run a Worksheet change macro on two sheets

Re: Run a Worksheet change macro on two sheets

Re: Run a Worksheet change macro on two sheets

Re: Run a Worksheet change macro on two sheets

Re: Run a Worksheet change macro on two sheets

Re: Run a Worksheet change macro on two sheets

Re: Run a Worksheet change macro on two sheets

Re: Run a Worksheet change macro on two sheets

Re: Run a Worksheet change macro on two sheets

Re: Run a Worksheet change macro on two sheets

Re: Run a Worksheet change macro on two sheets

Re: Run a Worksheet change macro on two sheets

Thread Information

Users Browsing this Thread

Tags for this Thread

Bookmarks

Bookmarks

Posting Permissions