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

Can you AutoAverage in Excel?
There is a drop-down next to the AutoSum symbol. Open the drop-down to choose AVERAGE, COUNT, MAX, or MIN
Replace all your code for this

VBA Code:
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:K")) 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_1@mail"
        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_2@mail"
        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
    Else
      'columns 10 and 11
      If MsgBox("pressing OK will send email to notify", vbOKCancel + vbInformation, "Amended Budget Approved") = vbOK Then
        
        'Data for MAIL 3
        sMail = "mail_3@mail"
        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, "K").Value & vbCrLf & "" & _
                "Please prepare an updated Budget Description "
        Call SendMail(sMail, sSubj, sBody)
      
        'Data for MAIL 4
        sMail = "mail_4@mail"
        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 according to the information on the SD grid"
        Call SendMail(sMail, sSubj, sBody)

        MsgBox "Outlook messages sent", , "Outlook message sents" ' Confirm Sent Email
      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
    .Recipients.Add (sMail)
    .Subject = sSubj
    .Body = sBody
    .Display 'Display Email
    .Send 'Send Email
  End With
End Sub
 
Upvote 0
wow that works!
you are amazing. much success in all you do
can i ask for a slight tweak?
can i split off columns 10 and 11 and have an email 5 and 6? meaning else column 10 email 3 and 4
else column 11 and email 5 and 6
how would i do that?

this is your code where i want to change the parameters
VBA Code:
Else
      'columns 10 and 11
      If MsgBox("pressing OK will send email to notify", vbOKCancel + vbInformation, "Amended Budget Approved") = vbOK Then
        
        'Data for MAIL 3
        sMail = "Chayac@metdev.org; leahw@metdev.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, "K").Value & vbCrLf & "" & _
                "Please prepare an updated Budget Description "
        Call SendMail(sMail, sSubj, sBody)
      
        'Data for MAIL 4
        sMail = "Chayaf@metdev.org; leahw@metdev.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 according to the information on the SD grid"
        Call SendMail(sMail, sSubj, sBody)
 
Upvote 0
column 10 email 3 and 4
else column 11 and email 5 and 6

Try this
VBA Code:
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:K")) 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_1@mail"
        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_2@mail"
        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 = 10 Then
      If MsgBox("pressing OK will send email to notify", vbOKCancel + vbInformation, "Amended Budget Approved") = vbOK Then
        
        'Data for MAIL 3
        sMail = "mail_3@mail"
        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, "K").Value & vbCrLf & "" & _
                "Please prepare an updated Budget Description "
        Call SendMail(sMail, sSubj, sBody)
      
        'Data for MAIL 4
        sMail = "mail_4@mail"
        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 according to the information on the SD grid"
        Call SendMail(sMail, sSubj, sBody)

        MsgBox "Outlook messages sent", , "Outlook message sents" ' Confirm Sent Email
      End If
    ElseIf Target.Column = 11 Then
      If MsgBox("pressing OK will send email to notify", vbOKCancel + vbInformation, "Amended Budget Approved") = vbOK Then
        
        'Data for MAIL 5
        sMail = "mail_5@mail"
        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, "K").Value & vbCrLf & "" & _
                "Please prepare an updated Budget Description "
        Call SendMail(sMail, sSubj, sBody)
      
        'Data for MAIL 6
        sMail = "mail_6@mail"
        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 according to the information on the SD grid"
        Call SendMail(sMail, sSubj, sBody)

        MsgBox "Outlook messages sent", , "Outlook message sents" ' Confirm Sent Email
      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
    .Recipients.Add (sMail)
    .Subject = sSubj
    .Body = sBody
    .Display 'Display Email
    .Send 'Send Email
  End With
End Sub
 
Upvote 0
it looks good. a test worked
lets see if in real life it will perform.
an additional "issue"
correction - the columns reflected are I and K:L
 
Upvote 0
correction - the columns reflected are I and K:L

Try:

VBA Code:
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")) 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_1@mail"
        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_2@mail"
        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_3@mail"
        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, "K").Value & vbCrLf & "" & _
                "Please prepare an updated Budget Description "
        Call SendMail(sMail, sSubj, sBody)
      
        'Data for MAIL 4
        sMail = "mail_4@mail"
        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 according to the information on the SD grid"
        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_5@mail"
        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_6@mail"
        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, "L").Value & vbCrLf & "" & _
                "Please update the records according to the information on the SD grid"
        Call SendMail(sMail, sSubj, sBody)

        MsgBox "Outlook messages sent", , "Outlook message sents" ' Confirm Sent Email
      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
    .Recipients.Add (sMail)
    .Subject = sSubj
    .Body = sBody
    .Display 'Display Email
    .Send 'Send Email
  End With
End Sub
 
Upvote 0
I'm glad to help you. Thanks for the feedback.
 
Upvote 0
hi
i must be doing something wrong when i add 2 recipients
VBA Code:
sMail = "chayac@metdev.org; leahw@metdev.org"
it says not recognized
 
Upvote 0
Change this line:
.Recipients.Add (sMail)

For this
Rich (BB code):
.to = sMail
 
Upvote 0

Forum statistics

Threads
1,213,494
Messages
6,113,988
Members
448,538
Latest member
alex78

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