Macro Code to Send Email if Cell Value is 'True', to recipient located in same row.

Hi,

So I have a worksheet where a list of emails are located in column C, and there are checkboxes (or could be true/false value if it makes it easier) in column T.

What I am trying to do is have an email sent when the checkbox is checked (or value is changed to 'True') to the email address that is located in the same row of that checkbox/true value. All of the emails would be identical, just always sent to the recipient corresponding to the same row where the box was checked/value changed to true.

Thanks in advanced.


Matt

.
You can edit this project to fit your needs. Change the column locations for the various bits of data and then make edits in the code to match.

Sub eMail()
Dim lRow As Integer
Dim i As Integer
Dim toDate As Date
Dim toList As String
Dim eSubject As String
Dim eBody As String

With Application
    .ScreenUpdating = False
    .EnableEvents = False
    .DisplayAlerts = False
End With

Sheets(1).Select
lRow = Cells(Rows.Count, 4).End(xlUp).Row

For i = 2 To lRow
  If (Cells(i, 1)) <> "" Then
     Set OutApp = CreateObject("Outlook.Application")
     Set OutMail = OutApp.CreateItem(0)

        toList = Cells(i, 2)    'gets the recipient from col D
        eSubject = "Bonus Assignment"
        
        msg = "Hello, " & Sheets("Sheet1").Range(i, "2").Value & vbNewLine & _
            "I am pleased to inform you that your annual bonus is " & Sheets("Sheet1").Range(i, "4").Value & vbNewLine & _
            "Sincerely, " & _
            "William Rose, President "

        On Error Resume Next
        With OutMail
        .To = toList
        .CC = ""
        .BCC = ""
        .Subject = eSubject
        .Body = eBody
        '.bodyformat = 1
        .Display   ' ********* Creates draft emails. Comment this out when you are ready
        '.Send     '********** UN-comment this when you  are ready to go live
        End With
 
    On Error GoTo 0
    Set OutMail = Nothing
    Set OutApp = Nothing
 Cells(i, 5) = "Mail Sent " & Date + Time 'Marks the row as "email sent in Column E"
End If
Next i

ActiveWorkbook.Save

With Application
    .ScreenUpdating = True
    .EnableEvents = True
    .DisplayAlerts = True
End With
End Sub

Hi!

This is great! I could make this work. Is there a way to have it send the email as soon as the value is entered. So, for instance, As soon as I place the "X" in Column A, the email is automatically sent to that recipient? Without needing to press the button.

The reason for this is that basically this will send an email to the recipient letting them know that their order is ready to pick up. But using this code I would need to remove the value from the cell after the email is sent or else each recipient will get repeated emails whenever I press the Button as long as there is still a value in the corresponding cell.

Thanks in advanced.

Matt

.
Here is a different version that is not automatic and allows you to clear the "to send" list so they are not receiving duplicate emails. Again, you will need to adjust the sheet and code to match your requirements.
This version also allows you to attach a document to an email if so desired.

Option Explicit

Sub PC_Email()
    
    Dim OutApp As Object
    Dim OutMail As Object
    Dim strbody As String
    Dim MailAttachments As String
    Dim cell As Variant '                             Not previously DIM'd
    
    Sheets("Sheet1").Select '                         Edit as required
    Range("A1").Select
    
    Application.ScreenUpdating = False
    Set OutApp = CreateObject("Outlook.Application")
    
  
   On Error GoTo cleanup
    For Each cell In Columns("C").Cells
        If cell.Value Like "?*@?*.?*" And _
        LCase(Cells(cell.Row, "H").Value) <> "" Then
        
        
    With Application.ActiveSheet
        MailAttachments = Cells(cell.Row, "G").Value
    End With
        
    
    Set OutMail = OutApp.CreateItem(0)
        
            On Error Resume Next
                              
            With OutMail
            
            strbody = "Hi " & Cells(cell.Row, "B") & "," & vbNewLine & vbNewLine & _
              "The " & Cells(cell.Row, "A") & " ACH Remittance for " & Cells(cell.Row, "D") & " is attached." & vbNewLine & _
              "Please let me know if you have any questions." & vbNewLine & vbNewLine & _
              "Thanks," & vbNewLine & vbNewLine & _
              "Accounts Payable" & vbNewLine & "Reily Foods"
              
                .To = cell.Value
                .Subject = Cells(cell.Row, "A") & " ACH Remittance"
                .Body = strbody
               
                .Attachments.Add MailAttachments
                
                .Display  'Or use .Send
                  
                
            End With
            On Error GoTo 0
            Set OutMail = Nothing
        End If
    Next cell


cleanup:
    Set OutApp = Nothing
    Application.ScreenUpdating = True
    
End Sub

Sub ClrMailToSend()
    Sheets("Sheet1").Range("H2:H100").Clear
End Sub