Get VBA to automatically generate an email when a cell meets a date condition

[Guitarmageddon]

Hey folks, I've found a mix of code online, but being relatively novice compared to you masters with VBA, Im a bit confused.

Here's what I'm trying to do. I have a store inventory activity tracking sheet. Field and HQ reps concurrently work in this sheet and add info as they receive it. The important column is the inventory date column ("D" in the screenshot below). Whenever anyone opens that sheet and the date in column "D" is 14 days or less from today, I want it to automatically generate an email for one/both of the recipients in that row, over in column "S" or "V" and be reminded that "STORE XXXX INVENTORY IS WITHIN 14 DAYS" or something to that effect. Sometimes there may only be one POC. For example, row 3 below would email johndoe and johnsmith, and row 5 would email johnking and johnsmith. Row 4 doesn't meet the date criteria so nothing generated.

Im wondering if potentially needing two or more emails to separate recipients, if conditions are met, adds any issues with the email client? Or if the code would step through each email line needed sequentially once the one prior is conducted?

Can anyone assist?

 

[Logit]

Try this :

Option Explicit

Sub emailall2()
Dim lRow As Integer
Dim i As Integer
Dim toDate As Date
Dim toList, CCList As String
Dim eSubject As String
Dim eBody As String
Dim OutApp, OutMail


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


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

Set OutApp = CreateObject("Outlook.Application")

For i = 3 To lRow
  If Cells(i, 4).Value = Date + 14 Then
     Set OutMail = OutApp.CreateItem(0)


        toList = Cells(i, 19)    'gets the recipient from col S
        CCList = Cells(i, 22)
        eSubject = "You are scheduled for an audit on " & Cells(i, 3) & " at " & Cells(i, 4) & " " & Cells(i, 6)
        eBody = "STORE " & Cells(i, 2) & " INVENTORY IS WITHIN 14 DAYS"
        
        On Error Resume Next
        With OutMail
        .To = toList
        .CC = CCList
        .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
 Cells(i, 24) = "Mail Sent " & Date + Time 'Marks the row as "email sent in Column A"
End If
Next i

Set OutApp = Nothing

ActiveWorkbook.Save


With Application
    .ScreenUpdating = True
    .EnableEvents = True
    .DisplayAlerts = True
End With
Sheets("Sheet1").Range("A1").Select
End Sub

 

[Guitarmageddon]

This is great! Just a small change to the date logic and it seems to be working as normal...

One dilemma though- what is the best way to trigger this? I have been getting it to trigger based on executing the macro manually, but that is the least ideal.

1) Is there an option to trigger the emails as soon as a date is entered that meets the criteria? Least intervention is probably best. however, if a user is just messing around in the sheet and accidentally enters a date that triggers the email, the potential for errant emails is there.
2) Could trigger by a send email button I suppose. so that when the user commits to being done with their data entry, it sends the emails.

The user I'm building this for did not want to use SharePoint online/Power automate so some of those nifty features are out, unfortunately.

 

[Logit]

Normally for this type project, someone would open the workbook each morning and press the Command Button to run the macro.
Any emails needing to be sent would do so at that time.

You could automate the process by placing a 'call' to the macro in the ThisWorkbook module for Workbook_Open.