many emails and many call macros

rjmdc

Well-known Member
Joined
Apr 29, 2020
Messages
672
Office Version
  1. 365
Platform
  1. Windows
hi
i messed up
my code worked when it was only email1 and email2 i guess i didnt add 3 and 4 correctly. was i maent to have a sub that lists all my macros as call email1 call email2
can someone sort it out for me?

VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)

    If Target.Cells.Count = 1 Then
        If Target.Column = 9 Then
            If Cells(Target.Row, "I").Value <> "" Then
            result = MsgBox("pressing OK will send email to notify", vbOKCancel + vbInformation, "Budget Approved")
           
            If result = vbCancel Then SaveUI = True
                If result = vbOK Then
                    Set OutlookApp = CreateObject("Outlook.Application")
                    Set OlObjects = OutlookApp.GetNamespace("MAPI")
                    Set newmsg = OutlookApp.CreateItem(olMailItem)
                   
                    Call SendEmail1(Target, "mail@mail") 'Email 1
                    Call SendEmail2(Target, "mail@mail") 'Email 2
                    MsgBox "Outlook messages sent", , "Outlook message sents" ' Confirm Sent Email
                End If
            End If
        End If
    End If
End Sub

Private Sub SendEmail1(ByVal Target As Range, sRecipient As String)
    Set OutlookApp = CreateObject("Outlook.Application")
    Set OlObjects = OutlookApp.GetNamespace("MAPI")
    Set newmsg = OutlookApp.CreateItem(olMailItem)
   
    With newmsg
        .Recipients.Add (sRecipient)
        .Subject = Cells(Target.Row, "A").Value & " budget was approved" ' Add Subject
        .Body = "Now that budget was approved for " & Cells(Target.Row, "A").Value & " on " & Cells(Target.Row, "I").Value & vbCrLf & "" & _
                "Please prepare Budget Description " ' Email Body
        .Display 'Display Email
        .Send 'Send Email
               
    End With
End Sub

Private Sub SendEmail2(ByVal Target As Range, sRecipient As String)
    Set OutlookApp = CreateObject("Outlook.Application")
    Set OlObjects = OutlookApp.GetNamespace("MAPI")
    Set newmsg = OutlookApp.CreateItem(olMailItem)
   
    With newmsg
        .Recipients.Add (sRecipient)
        .Subject = Cells(Target.Row, "A").Value & " budget was approved" ' Add Subject
        .Body = "Now that budget was approved for " & Cells(Target.Row, "A").Value & " on " & Cells(Target.Row, "I").Value & vbCrLf & "" & _
                "Please train broker for proper reimbursement billing" ' Email Body
        .Display 'Display Email
        .Send 'Send Email
               
    End With
End Sub
Private Sub AmendedBudget(ByVal Target As Range)

    If Target.Cells.Count = 1 Then
        If Target.Column = 11 Or Target.Column = 12 Then
            If Cells(Target.Row, "K").Value <> "" Or Cells(Target.Row, "L").Value <> "" Then
            result = MsgBox("pressing OK will send email to notify", vbOKCancel + vbInformation, "Amended Budget Approved")
           
            If result = vbCancel Then SaveUI = True
                If result = vbOK Then
                    Set OutlookApp = CreateObject("Outlook.Application")
                    Set OlObjects = OutlookApp.GetNamespace("MAPI")
                    Set newmsg = OutlookApp.CreateItem(olMailItem)
                   
                    Call SendEmail3(Target, "mail@mail") 'Email 3
                    Call SendEmail4(Target, "mail@mail") 'Email 4
                    MsgBox "Outlook messages sent", , "Outlook message sents" ' Confirm Sent Email
                End If
            End If
        End If
    End If
End Sub
Private Sub SendEmail3(ByVal Target As Range, sRecipient As String)
    Set OutlookApp = CreateObject("Outlook.Application")
    Set OlObjects = OutlookApp.GetNamespace("MAPI")
    Set newmsg = OutlookApp.CreateItem(olMailItem)
   
    With newmsg
        .Recipients.Add (sRecipient)
        .Subject = Cells(Target.Row, "A").Value & " Amended budget was approved" ' Add Subject
        .Body = "Now that there is an amended budget approval for " & Cells(Target.Row, "A").Value & " on " & Cells(Target.Row, "K").Value & vbCrLf & "" & _
                "Please prepare an updated Budget Description " ' Email Body
        .Display 'Display Email
        .Send 'Send Email
               
    End With
End Sub

Private Sub SendEmail4(ByVal Target As Range, sRecipient As String)
    Set OutlookApp = CreateObject("Outlook.Application")
    Set OlObjects = OutlookApp.GetNamespace("MAPI")
    Set newmsg = OutlookApp.CreateItem(olMailItem)
   
    With newmsg
        .Recipients.Add (sRecipient)
        .Subject = Cells(Target.Row, "A").Value & " budget amendment was approved" ' Add Subject
        .Body = "This is a notification that an amended budget was approved for " & Cells(Target.Row, "A").Value & " on " & Cells(Target.Row, "K").Value & vbCrLf & "" & _
                "Please update the records according to the information on the SD grid" ' Email Body
        .Display 'Display Email
        .Send 'Send Email
               
    End With
End Sub
 

Excel Facts

Copy PDF to Excel
Select data in PDF. Paste to Microsoft Word. Copy from Word and paste to Excel.
stuck again
now i need to add this part with the rest of the email style information.
i cannot make this work

If Target.Cells.Count = 1 Then
If Target.Column = 16 And AscW(Target.Value & " ") = 10004 Then
result = MsgBox("pressing OK will send email to notify", vbOK + vbExclamation, "can send Startup Lp draft")
 
Upvote 0
If Target.Cells.Count = 1 Then
Why that instruction, if we are using this:
If Target.CountLarge > 1 Then Exit Sub

__________________________________________________________________________________
If Target.Column = 16 And AscW(Target.Value & " ") = 10004 Then
Why If Target.Column = 16, if we are using this:
ElseIf Target.Column = 12 Then
__________________________________________________________________________________

If Target.Column = 16 And AscW(Target.Value & " ") = 10004 Then
Why that instruction?

__________________________________________________________________________________
For column 16 to work, you must first change this statement
If Not Intersect(Target, Range("I:I, K:L")) Is Nothing Then

To this:
If Not Intersect(Target, Range("I:I, K:L, P:P")) Is Nothing Then

__________________________________________________________________________________
If this is for another sheet, you will need to create a new thread.
 
Upvote 0
i tried
this was my version but it didnt work

Private Sub Worksheet_Change(ByVal Target As Range)
Dim sMail As String, sSubj As String, sBody As String

If Target.CountLarge > 1 Then Exit Sub
If Target.Value = "" Then Exit Sub
If Not Intersect(Target, Range("I:I, K:L, P:P")) Is Nothing Then
If Target.Column = 9 Then
If MsgBox("Pressing OK will send email to notify", vbOKCancel + vbInformation, "Budget Approved") = vbOK Then

'Data for MAIL 1
sMail = "mail@mail.org"
sSubj = Cells(Target.Row, "A").Value & " budget was approved"
sBody = "Now that budget was approved for " & Cells(Target.Row, "A").Value & " on " & _
Cells(Target.Row, "I").Value & vbCrLf & "" & "Please prepare Budget Description "
Call SendMail(sMail, sSubj, sBody)

'Data for MAIL 2
sMail = "mail@mail.org"
sSubj = Cells(Target.Row, "A").Value & " budget was approved"
sBody = "Now that budget was approved for " & Cells(Target.Row, "A").Value & " on " & _
Cells(Target.Row, "I").Value & vbCrLf & "" & "Please train broker for proper reimbursement billing"
Call SendMail(sMail, sSubj, sBody)

MsgBox "Outlook messages sent", , "Outlook message sents" ' Confirm Sent Email
End If
ElseIf Target.Column = 11 Then ' Column "K"
If MsgBox("pressing OK will send email to notify", vbOKCancel + vbInformation, "Amended Budget Approved") = vbOK Then

'Data for MAIL 3
sMail = "mail@mail.org"
sSubj = Cells(Target.Row, "A").Value & " Budget amendment was approved"
sBody = "Now that there is an amended budget approval for " & Cells(Target.Row, "A").Value & " on " & Cells(Target.Row, "K").Value & vbCrLf & "" & _
"Please prepare an updated Budget Description "
Call SendMail(sMail, sSubj, sBody)

'Data for MAIL 4
sMail = "mail@mail.org"
sSubj = Cells(Target.Row, "A").Value & " Budget Amendment was approved"
sBody = "This is a notification that an amended budget was approved for " & Cells(Target.Row, "A").Value & " on " & Cells(Target.Row, "K").Value & vbCrLf & "" & _
"Please update the records accordingly"
Call SendMail(sMail, sSubj, sBody)

MsgBox "Outlook messages sent", , "Outlook message sents" ' Confirm Sent Email
End If
ElseIf Target.Column = 12 Then ' Column "L"
If MsgBox("pressing OK will send email to notify", vbOKCancel + vbInformation, "Amended Budget Approved") = vbOK Then

'Data for MAIL 5
sMail = "mail@mail.org"
sSubj = Cells(Target.Row, "A").Value & " Amended budget was approved"
sBody = "Now that there is an Amended Budget approval for " & Cells(Target.Row, "A").Value & " on " & Cells(Target.Row, "L").Value & vbCrLf & "" & _
"Please prepare an updated Budget Description "
Call SendMail(sMail, sSubj, sBody)

'Data for MAIL 6
sMail ="mail@mail.org"
sSubj = Cells(Target.Row, "A").Value & " Amended Budget was approved"
sBody = "This is a notification that an Amended Budget was approved for " & Cells(Target.Row, "A").Value & " on " & Cells(Target.Row, "L").Value & vbCrLf & "" & _
"Please update the records accordingly"
Call SendMail(sMail, sSubj, sBody)

MsgBox "Outlook messages sent", , "Outlook message sents" ' Confirm Sent Email

' ElseIf Target.Column = 16 Then ' Column "P"
' ' If MsgBox("pressing OK will send email to notify", vbOKCancel + vbInformation, "Amended Budget Approved") = vbOK Then
'
' 'Data for MAIL 7
' sMail = "mail@mail.org"
' sSubj = Cells(Target.Row, "A").Value & " hass DPP services. "
' sBody = "Since the following participant has DPP Services " & vbCrLf & "" & _
' "Please update SD Participants sheet accordingly. "
' Call SendMail(sMail, sSubj, sBody)
' End If
' End If
End If
End If
End If
End Sub

Sub SendMail(sMail, sSubj, sBody)
Dim OutlookApp As Object
Set OutlookApp = CreateObject("Outlook.Application").CreateItem(0)
With OutlookApp
.to = sMail
.Subject = sSubj
.Body = sBody
.Display 'Display Email
.Send 'Send Email
End With
End Sub
 
Upvote 0
same sheet
column 16 if gets filled with a check mark which is AscW(Target.Value & " ") = 10004

i tried and attached when i followed your previous instruction adding "P:P" and column 16

please advise
 
Upvote 0
Sorry, but I do not understand, you are not answering my doubts and I do not understand what you want to do.
 
Upvote 0
sorry
what is your question?
i am trying to add email7
this means when column P is changed
how would i do that?
 
Upvote 0
i tried this but it didnt work
If Not Intersect(Target, Range("I:I, K:L, P:P")) Is Nothing Then
 
Upvote 0
what is your question?

rjmdc said:
If Target.Cells.Count = 1 Then
Why that instruction, if we are using this:
If Target.CountLarge > 1 Then Exit Sub

__________________________________________________________________________________
rjmdc said:
If Target.Column = 16 And AscW(Target.Value & " ") = 10004 Then
Why If Target.Column = 16, if we are using this:
ElseIf Target.Column = 12 Then
__________________________________________________________________________________

rjmdc said:
If Target.Column = 16 And AscW(Target.Value & " ") = 10004 Then
Why that instruction?
 
Upvote 0

Forum statistics

Threads
1,213,527
Messages
6,114,150
Members
448,552
Latest member
WORKINGWITHNOLEADER

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top