How to send email to specific recipients if corresponding cell contains the word " expired"?

Question

I have a list of email address but I need to send an email to only the individuals that have "expired" in their corresponding cell. On button click, it is opening multiple outlook windows.

This is what I have so far:

Private Sub CommandButton1_Click()
Dim c As Range
For Each c In Range("F5:F42")
    If c.Value2 = "Expired" Then Call Mail_small_Text_Outlook(c.Offset(0, -3).Value2)
Next c
End Sub
Sub Mail_small_Text_Outlook(emailAddress As String)

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

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    
Set ws = Sheets("Sheet1")
 Set Rng = ws.Range(ws.Range("A1"), ws.Range("A" & Rows.Count).End(xlUp))
  
    For Each cell In Rng
           
    If cell.Value2 = "Expired" Then
      SendTo = SendTo & cell.Value & ";"
    End If
   Next
    
    strbody = "Hello," & vbNewLine & vbNewLine & _
              "You are receiving this email because your Wastewater Pathogens (Annual) is now expired or will expire within the next 30 days. Please sign up for the next available class in LMS. If you are unable to sign up in LMS, please contact Christa Scott." & vbNewLine & _
              "Thank you and have a nice day."

    On Error Resume Next
    With OutMail
        .To = SendTo
        .CC = ""
        .BCC = ""
        .Subject = "Expired Hazmat Right-to-Know Training - " & Date
        .Body = strbody

        .Display 'or .Send to automatically send email.
    End With
    On Error GoTo 0

    Set OutMail = Nothing
    Set OutApp = Nothing

End Sub

Then use cell.Offset(,5).Value in the if statement on instead of cell.Value2. — norie, Apr 09 '21 at 14:29
That worked but now its opening too many outlook windows. My code for the button is above. — PowerAppsNewbie, Apr 09 '21 at 14:50
All you needed to do was make the change I suggested in the original code you posted. — norie, Apr 09 '21 at 14:55
I have a button that is clicked to begin the process. Do I need to change the range or c.Value2 to cell.Offset(,5).Value in that if statement as well? — PowerAppsNewbie, Apr 09 '21 at 15:15

score 1 · Accepted Answer · answered Apr 09 '21 at 15:29

To run the code from a command button call it once, and to check for 'expired' in column F use cell.Offset(,5).Value2.

Option Explicit

Private Sub CommandButton1_Click()
    Call Mail_small_Text_Outlook
End Sub

Sub Mail_small_Text_Outlook()
Dim ws As Worksheet
Dim rng As Range
Dim cell As Range
Dim OutApp As Object
Dim OutMail As Object
Dim strSendTo As String
Dim strBody As String

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

    Set ws = Sheets("Sheet1")
    Set rng = ws.Range(ws.Range("A1"), ws.Range("A" & Rows.Count).End(xlUp))

    For Each cell In rng
        If cell.Offset(, 5).Value2 = "Expired" Then
            strSendTo = strSendTo & cell.Value & ";"
        End If
    Next

    strBody = "Hello," & vbNewLine & vbNewLine & _
              "You are receiving this email because your Wastewater Pathogens (Annual) is now expired or will expire within the next 30 days. Please sign up for the next available class in LMS. If you are unable to sign up in LMS, please contact Christa Scott." & vbNewLine & _
              "Thank you and have a nice day."

    On Error Resume Next
    With OutMail
        .To = strSendTo
        .CC = ""
        .BCC = ""
        .Subject = "Expired Hazmat Right-to-Know Training - " & Date
        .Body = strBody

        .Display    'or .Send to automatically send email.
    End With
    On Error GoTo 0

    Set OutMail = Nothing
    Set OutApp = Nothing

End Sub

How to send email to specific recipients if corresponding cell contains the word " expired"?

1 Answers1