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

Guitarmageddon

Board Regular
Joined
Dec 22, 2014
Messages
161
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?


1709042857860.png
 

Excel Facts

Which Excel functions can ignore hidden rows?
The SUBTOTAL and AGGREGATE functions ignore hidden rows. AGGREGATE can also exclude error cells and more.
Try this :

VBA Code:
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
 
Upvote 0
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.
 
Upvote 0
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.
 
Upvote 0

Forum statistics

Threads
1,224,820
Messages
6,181,157
Members
453,021
Latest member
Justyna P

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