How to run an Email reminder macro automatically without manually changing data

[Stephen1313]

I have a task tracker worksheet that I use with my staff. I have added quite a bit of functionality to it and have been working on a final item to automatically send email reminders based on a days left counter that uses the formula in the H column cells : '=[@[Due Date]]-TODAY()' which is essentially takes the due dates contained in column G and subtracts them from todays date and puts the value of days left into column G. I have set up a MACRO that searches Column H for specific days remaining as the trigger to send a reminder email (specifically 14, 7, and 0) as well as placing the status of emails sent into column M. That Macro works perfectly but I want to know if there is a way to make it so this macro works behind the scenes based on the counter as the days change which is automatic or at least appears so when i open excel. Is there a way to write this in VBA maybe using event handlers? Can this be done with out the workbook being open? Here is a image of my sheet and the code below is the email MACRO. Thanks in advance!

Sub Email_Reminder()
Sheets("Project Tracker ").Select
    Dim OutApp As Object
    Dim OutMail As Object
    Dim strto As String, strcc As String, strbcc As String
    Dim strsub As String, strbody As String
    Dim FormulaRange As Range
    Dim NotSentMsg As String
    Dim MyMsg As String
    Dim SentMsg As String
    Dim FirstMsg As String
    Dim SecondMsg As String
    Dim FinalMsg As String
    Dim VarRange As String
    Dim last_row As Long
      
    NotSentMsg = "No Reminder Sent"
    SentMsg = "Sent"
    FirstMsg = "1st Reminder Sent"
    SecondMsg = "2nd Reminder Sent"
    FinalMsg = "Final Reminder Sent"
    last_row = Cells(Rows.Count, 8).End(xlUp).Row
   

    'Set the range with Formulas that you want to check
    Set FormulaRange = Range(Cells(2, 8), Cells(last_row, 8))
    

    On Error GoTo EndMacro:
    For Each Formulacell In FormulaRange.Cells
        With Formulacell
            If .Value = 14 Then
                MyMsg = "First Reminder Sent"
                If .Offset(0, 5).Value = NotSentMsg Then
                                               
                        Set OutApp = CreateObject("Outlook.Application")
                        Set OutMail = OutApp.CreateItem(0)
                        strto = Cells(Formulacell.Row, "K").Value
                        strcc = Cells(Formulacell.Row, "L").Value
                        strbcc = ""
                        strsub = "Task Tracker Automatic First Reminder"
                        strbody = "Hi " & Cells(Formulacell.Row, "C").Value & vbNewLine & vbNewLine & _
                        "This is a reminder that task " & Cells(Formulacell.Row, "A").Value & _
                        vbNewLine & vbNewLine & "is coming due in 14 days!"

     
                        OutMail.to = strto
                        OutMail.CC = strcc
                        OutMail.BCC = strbcc
                        OutMail.Subject = strsub
                        OutMail.Body = strbody
                        'You can add a file to the mail like this
                        '.Attachments.Add ("C:\test.txt")
                        OutMail.Display    ' or use .Send
                        Set OutMail = Nothing
                        Set OutApp = Nothing
                          
                    End If
            Else
                If .Value = 7 Then
                    MyMsg = SecondMsg
                    If .Offset(0, 5).Value = FirstMsg Or .Offset(0, 5).Value = NotSentMsg Then
                        'Call Mail_with_outlook2
                        Set OutApp = CreateObject("Outlook.Application")
                        Set OutMail = OutApp.CreateItem(0)
                        strto = Cells(Formulacell.Row, "K").Value
                        strcc = Cells(Formulacell.Row, "L").Value
                        strbcc = ""
                        strsub = "Task Tracker Automatic Second Reminder"
                        strbody = "Hi " & Cells(Formulacell.Row, "C").Value & vbNewLine & vbNewLine & _
                        "This is a reminder that task " & Cells(Formulacell.Row, "A").Value & _
                        vbNewLine & vbNewLine & "is coming due 7 days!"

     
                        OutMail.to = strto
                        OutMail.CC = strcc
                        OutMail.BCC = strbcc
                        OutMail.Subject = strsub
                        OutMail.Body = strbody
                        'You can add a file to the mail like this
                        '.Attachments.Add ("C:\test.txt")
                        OutMail.Display    ' or use .Send
                        Set OutMail = Nothing
                        Set OutApp = Nothing
                    End If
            Else
                If .Value = 0 Then
                    MyMsg = FinalMsg
                    If .Offset(0, 5).Value = SecondMsg Or .Offset(0, 5).Value = FirstMsg Or .Offset(0, 5).Value = NotSentMsg Then
                        'Call Mail_with_outlook3
                        Set OutApp = CreateObject("Outlook.Application")
                        Set OutMail = OutApp.CreateItem(0)
                        strto = Cells(Formulacell.Row, "K").Value
                        strcc = Cells(Formulacell.Row, "L").Value
                        strbcc = ""
                        strsub = "Task Tracker Automatic Final Reminder"
                        strbody = "Hi " & Cells(Formulacell.Row, "C").Value & vbNewLine & vbNewLine & _
                        "This is a reminder that task " & Cells(Formulacell.Row, "A").Value & _
                        vbNewLine & vbNewLine & "is due today!"

     
                        OutMail.to = strto
                        OutMail.CC = strcc
                        OutMail.BCC = strbcc
                        OutMail.Subject = strsub
                        OutMail.Body = strbody
                        'You can add a file to the mail like this
                        '.Attachments.Add ("C:\test.txt")
                        OutMail.Display    ' or use .Send
                        Set OutMail = Nothing
                        Set OutApp = Nothing
                    End If
                Else
                    MyMsg = NotSentMsg
                End If
            End If
            End If
            Application.EnableEvents = False
            .Offset(0, 5).Value = MyMsg
            Application.EnableEvents = True
        End With
    Next Formulacell
ExitMacro:
    Exit Sub

EndMacro:
    Application.EnableEvents = True

    MsgBox "Some Error occurred." _
         & vbLf & Err.Number _
         & vbLf & Err.Description

End Sub

 

[Logit]

.
You say the macro runs as needed ... no errors.

So, in the ThisWorkbook module, paste the following :

Option Explicit

Private Sub Workbook_Open()
    Email_Reminder
End Sub

 

[Stephen1313]

so I see what you did. Now when I open the workbook or presumably whenever someone opens it, it will run the macro which is exactly what happened when i tested it. Is there a way to have it run automatically behind the scenes even if the workbook isn't open? or do the formula cells that reference TODAY only update when the book is open? My concern with the solution provided is that this is a shared file so theoretically if multiple people open the file each day and do not save it after the macro runs the first time (since I have logic loops that change the reference variable in the MACRO to eliminate repeat emails, but those would only carry over if the file was saved) it could send multiple email reminders. I supposed I could program in an auto save into the email MACRO to eliminate this but my preferred solution if it exists is to have this run behind the scenes even if the file isn't open... I just don't know if that is even possible

 

[Logit]

If this will always be a shared file ... I would not have the macro auto run when the workbook is opened. You will experience the issues
you've already outlined.

The workbook must be open for the macro to run. Close the workbook and the macro stops. That's just the way Excel works.

Again, if this will always be a shared workbook ... I think you should place the email macro in a separate workbook. Have that new
workbook always running in the background. Create another macro to copy the data from the SHARED workbook. Use that
copied data for the email macro to run on. When the email has been sent, clear the temp sheet of the data that was copied/paste.

You could time the macro to run say every 4 hours or 6 hours or even just once a day. Whatever you think would best serve your
needs.

 

[Stephen1313]

Okay I had a feeling that would be the case but I wanted to consult the experts on here. Thank you for taking the time to help me out!

 

[Logit]