CODEWITHSUNDEEP
excelvba
tom jones
tom jones

Reputation: 1

excel, combine two vba worksheet change events?

I am trying to run multiple worksheet change events, but my second macro doesn't seem to be working when macro 1 is also present. macro 1 however does work.

I have tried combining the two together but still no luck, can anyone please show me where I am going wrong?

macro 1

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Column = Range("CA8").Column Then

 Dim Email_Subject, Email_Send_From, Email_Send_To, _
 Email_Cc, Email_Bcc, Email_Body As String
 Dim Mail_Object, Mail_Single As Variant
 Email_Subject = "New Supplier Set-Up Confirmation"
 Email_Send_From = "[email protected]"
 Email_Send_To = Range("AF" & ActiveCell.Row)
 Email_Cc = "[email protected]"
 Email_Bcc = ""
 Email_Body = "Dear " & Range("AE" & ActiveCell.Row) & "," & vbNewLine & vbNewLine & "This is to confirm that the following supplier was set-up on AX, on " & Range("CB" & ActiveCell.Row) & "." & vbNewLine & vbNewLine & "Supplier Name: " & Range("B" & ActiveCell.Row) & vbNewLine & "Supplier Number: " & Range("F" & ActiveCell.Row) & vbNewLine & "Supplier Status: " & Range("D" & ActiveCell.Row) & vbNewLine & vbNewLine & "Kind Regards," & vbNewLine & "The Purchasing Team"
 On Error GoTo debugs
 Set Mail_Object = CreateObject("Outlook.Application")
 Set Mail_Single = Mail_Object.CreateItem(0)
 With Mail_Single
 .Subject = "New Supplier Set-Up Confirmation"
 .to = Range("AF" & ActiveCell.Row)
 .CC = "[email protected]"
 .BCC = ""
 .Body = Email_Body
 .Send
 End With
debugs:
 If Err.Description <> "" Then MsgBox Err.Description



End If
End If
End Sub

macro 2:

Private Sub Worksheet_Change2(ByVal Target As Range)
 If ActiveCell.Address(False, False) = "CD8" Then

    Dim OutApp As Object
    Dim OutMail As Object
    Dim strbody As String

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    strbody = "Dear Sumayra," & vbNewLine & vbNewLine & _
              "Please would you complete the bank details set-up for the following supplier." & vbNewLine & vbNewLine & _
              "Supplier Name: " & Range("B" & ActiveCell.Row) & vbNewLine & _
              "Supplier Number: " & Range("F" & ActiveCell.Row) & vbNewLine & _
              "Supplier Status: " & Range("D" & ActiveCell.Row) & vbNewLine & vbNewLine & _
              "Kind Regards," & vbNewLine & _
              "Automated Purchasing Email"

    On Error Resume Next
    With OutMail
        .to = "[email protected]"
        .CC = "[email protected]"
        .BCC = ""
        .Subject = "New Supplier Bank Details Set-Up"
        .Body = strbody
        'You can add a file like this
        '.Attachments.Add ("C:\test.txt")
        .Send   'or use .Display
    End With
    On Error GoTo 0

    Set OutMail = Nothing
    Set OutApp = Nothing


End If
End Sub

Here's what I've tried:

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Column = Range("CA8").Column Then

     Dim Email_Subject, Email_Send_From, Email_Send_To, _
     Email_Cc, Email_Bcc, Email_Body As String
     Dim Mail_Object, Mail_Single As Variant
     Email_Subject = "New Supplier Set-Up Confirmation"
     Email_Send_From = "[email protected]"
     Email_Send_To = Range("AF" & ActiveCell.Row)
     Email_Cc = "[email protected]"
     Email_Bcc = ""
     Email_Body = "Dear " & Range("AE" & ActiveCell.Row) & "," & vbNewLine & vbNewLine & "This is to confirm that the following supplier was set-up on AX, on " & Range("CB" & ActiveCell.Row) & "." & vbNewLine & vbNewLine & "Supplier Name: " & Range("B" & ActiveCell.Row) & vbNewLine & "Supplier Number: " & Range("F" & ActiveCell.Row) & vbNewLine & "Supplier Status: " & Range("D" & ActiveCell.Row) & vbNewLine & vbNewLine & "Kind Regards," & vbNewLine & "The Purchasing Team"
     On Error GoTo debugs
     Set Mail_Object = CreateObject("Outlook.Application")
     Set Mail_Single = Mail_Object.CreateItem(0)
     With Mail_Single
     .Subject = "New Supplier Set-Up Confirmation"
     .to = Range("AF" & ActiveCell.Row)
     .CC = "[email protected]"
     .BCC = ""
     .Body = Email_Body
     .Send
     End With
debugs:
     If Err.Description <> "" Then MsgBox Err.Description


    If ActiveCell.Address(False, False) = "CD8" Then

        Dim OutApp As Object
        Dim OutMail As Object
        Dim strbody As String

        Set OutApp = CreateObject("Outlook.Application")
        Set OutMail = OutApp.CreateItem(0)

        strbody = "Dear Sumayra," & vbNewLine & vbNewLine & _
                  "Please would you complete the bank details set-up for the following supplier." & vbNewLine & vbNewLine & _
                  "Supplier Name: " & Range("B" & ActiveCell.Row) & vbNewLine & _
                  "Supplier Number: " & Range("F" & ActiveCell.Row) & vbNewLine & _
                  "Supplier Status: " & Range("D" & ActiveCell.Row) & vbNewLine & vbNewLine & _
                  "Kind Regards," & vbNewLine & _
                  "Automated Purchasing Email"

        On Error Resume Next
        With OutMail
            .to = "[email protected]"
            .CC = "[email protected]"
            .BCC = ""
            .Subject = "New Supplier Bank Details Set-Up"
            .Body = strbody
            'You can add a file like this
            '.Attachments.Add ("C:\test.txt")
            .Send   'or use .Display
        End With
        On Error GoTo 0

        Set OutMail = Nothing
        Set OutApp = Nothing



    End If


    End If
    End Sub

Upvotes: 0

Views: 462

Answers (2)

Siphor
Siphor

Reputation: 2544

Does this work?

Private Sub Worksheet_Change(ByVal Target As Range)
    Macro1 Target
    Macro2 Target
end sub

Private Sub Macro1(ByVal Target As Range)
    If Target.Column = Range("CA8").Column Then

 Dim Email_Subject, Email_Send_From, Email_Send_To, _
 Email_Cc, Email_Bcc, Email_Body As String
 Dim Mail_Object, Mail_Single As Variant
 Email_Subject = "New Supplier Set-Up Confirmation"
 Email_Send_From = "[email protected]"
 Email_Send_To = Range("AF" & ActiveCell.Row)
 Email_Cc = "[email protected]"
 Email_Bcc = ""
 Email_Body = "Dear " & Range("AE" & ActiveCell.Row) & "," & vbNewLine & vbNewLine & "This is to confirm that the following supplier was set-up on AX, on " & Range("CB" & ActiveCell.Row) & "." & vbNewLine & vbNewLine & "Supplier Name: " & Range("B" & ActiveCell.Row) & vbNewLine & "Supplier Number: " & Range("F" & ActiveCell.Row) & vbNewLine & "Supplier Status: " & Range("D" & ActiveCell.Row) & vbNewLine & vbNewLine & "Kind Regards," & vbNewLine & "The Purchasing Team"
 On Error GoTo debugs
 Set Mail_Object = CreateObject("Outlook.Application")
 Set Mail_Single = Mail_Object.CreateItem(0)
 With Mail_Single
 .Subject = "New Supplier Set-Up Confirmation"
 .to = Range("AF" & ActiveCell.Row)
 .CC = "[email protected]"
 .BCC = ""
 .Body = Email_Body
 .Send
 End With
debugs:
 If Err.Description <> "" Then MsgBox Err.Description



End If
End If
End Sub


Private Sub Macro2(ByVal Target As Range)
 If ActiveCell.Address(False, False) = "CD8" Then

    Dim OutApp As Object
    Dim OutMail As Object
    Dim strbody As String

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    strbody = "Dear Sumayra," & vbNewLine & vbNewLine & _
              "Please would you complete the bank details set-up for the following supplier." & vbNewLine & vbNewLine & _
              "Supplier Name: " & Range("B" & ActiveCell.Row) & vbNewLine & _
              "Supplier Number: " & Range("F" & ActiveCell.Row) & vbNewLine & _
              "Supplier Status: " & Range("D" & ActiveCell.Row) & vbNewLine & vbNewLine & _
              "Kind Regards," & vbNewLine & _
              "Automated Purchasing Email"

    On Error Resume Next
    With OutMail
        .to = "[email protected]"
        .CC = "[email protected]"
        .BCC = ""
        .Subject = "New Supplier Bank Details Set-Up"
        .Body = strbody
        'You can add a file like this
        '.Attachments.Add ("C:\test.txt")
        .Send   'or use .Display
    End With
    On Error GoTo 0

    Set OutMail = Nothing
    Set OutApp = Nothing


End If
End Sub

Upvotes: 0

brainac
brainac

Reputation: 410

I can't tell for sure not seeing your worksheet, but I expect If ActiveCell.Address(False, False) = "CD8" causes problem. ActiveCell returns Range that is active after change. So for example when you change A1 cell and hit enter, Change event will be triggered, and ActiveCell will be A2. To check if it was A1, you need to use Target that is supplied by the event.

Upvotes: 0

Related Questions