The provided VBA code automates the sending of email reminders...

August 26, 2025 at 04:35 PM

Option Explicit

' ===== CONFIG =====
Private Const SHEET_NAME As String = "Tasks Individual"   ' your data sheet
Private Const HEADER_ROW As Long = 1

' Columns (numbers): G=7, H=8, I=9, J=10, K=11, L=12, D=4
Private Const COL_DUE        As Long = 7        ' G: Due Date (Reminder Start Date)
Private Const COL_REG_DUE    As Long = 9        ' I: Regulatory Due Date
Private Const COL_STATUS     As Long = 10       ' J: Status
Private Const COL_AGENT      As Long = 11       ' K: Reporting Agent
Private Const COL_OWNER      As Long = 12       ' L: Owner
Private Const COL_REPORT     As Long = 4        ' D: Report (for subject)

Private Const STATUS_NOT_STARTED As String = "Not Started"
Private Const STATUS_COMPLETED   As String = "Completed"

' Email directory sheet: col A = Name, col B = Email
Private Const DIR_SHEET As String = "EmailDirectory"

Private Const PREVIEW_EMAIL As Boolean = False  ' True = .Display, False = .Send

Public Sub SendOwnerAgentReminders_WeeklyMonday()
    Dim ws As Worksheet, lastRow As Long, lastCol As Long
    Dim r As Long, statusTxt As String, ownerText As String, agentText As String
    Dim dueDate As Variant, regDueDate As Variant, reportName As String
    Dim lastNotifiedCol As Long, lastNotifiedHdr As String, lastNotified As Variant
    Dim olApp As Object, mail As Object
    Dim today As Date: today = Date
    Dim sentCount As Long, allEmails As String

    ' Only run on Mondays
    If Weekday(today, vbMonday) <> 1 Then Exit Sub

    Set ws = ThisWorkbook.Worksheets(SHEET_NAME)

    ' Ensure "Last Notified" column exists
    lastCol = ws.Cells(HEADER_ROW, ws.Columns.Count).End(xlToLeft).Column
    lastNotifiedHdr = "Last Notified"
    lastNotifiedCol = FindHeaderColumn(ws, HEADER_ROW, lastNotifiedHdr)
    If lastNotifiedCol = 0 Then
        lastNotifiedCol = lastCol + 1
        ws.Cells(HEADER_ROW, lastNotifiedCol).Value = lastNotifiedHdr
    End If

    lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
    If lastRow <= HEADER_ROW Then Exit Sub

    On Error Resume Next
    Set olApp = CreateObject("Outlook.Application")
    On Error GoTo 0
    If olApp Is Nothing Then Exit Sub

    For r = HEADER_ROW + 1 To lastRow
        statusTxt = Trim$(CStr(ws.Cells(r, COL_STATUS).Value))
        If Len(statusTxt) = 0 Then GoTo NextRow
        If LCase$(statusTxt) = LCase$(STATUS_COMPLETED) Then GoTo NextRow

        dueDate = ws.Cells(r, COL_DUE).Value
        regDueDate = ws.Cells(r, COL_REG_DUE).Value
        If Not (IsDate(dueDate) And IsDate(regDueDate)) Then GoTo NextRow

        ' Date window: G <= today <= I
        If DateValue(today) < DateValue(dueDate) Then GoTo NextRow
        If DateValue(today) > DateValue(regDueDate) Then GoTo NextRow

        ' Resolve Owner + Agent emails (direct email or lookup by name)
        allEmails = ResolveRecipient(ws.Cells(r, COL_OWNER).Value)
        If Len(allEmails) = 0 Then GoTo TryAgent
        allEmails = NormalizeEmails(allEmails)

TryAgent:
        Dim agentEmails As String
        agentEmails = ResolveRecipient(ws.Cells(r, COL_AGENT).Value)
        If Len(agentEmails) > 0 Then
            agentEmails = NormalizeEmails(agentEmails)
            allEmails = IIf(Len(allEmails) > 0, allEmails & ";" & agentEmails, agentEmails)
        End If

        If Len(allEmails) = 0 Then GoTo NextRow

        ' Weekly throttle (send if never sent OR last sent >= 7 days ago)
        lastNotified = ws.Cells(r, lastNotifiedCol).Value
        If IsDate(lastNotified) Then
            If DateDiff("d", CDate(lastNotified), today) < 7 Then GoTo NextRow
        End If

        reportName = CStr(ws.Cells(r, COL_REPORT).Value)

        ' Compose & send
        Set mail = olApp.CreateItem(0)
        With mail
            .To = allEmails
            .Subject = "Weekly Reminder: " & IIf(Len(reportName) > 0, reportName & " — ", "") & "Action Needed"
            .body = BuildPlainTextBody(ws, r)
            If PREVIEW_EMAIL Then .Display Else .Send
        End With

        ws.Cells(r, lastNotifiedCol).Value = today
        sentCount = sentCount + 1

NextRow:
        allEmails = ""
    Next r

    If sentCount > 0 Then MsgBox sentCount & " weekly reminder(s) sent.", vbInformation
End Sub

' ---------- Helpers ----------
Private Function FindHeaderColumn(ws As Worksheet, hdrRow As Long, hdrText As String) As Long
    Dim lastCol As Long, c As Long
    lastCol = ws.Cells(hdrRow, ws.Columns.Count).End(xlToLeft).Column
    For c = 1 To lastCol
        If StrComp(Trim$(CStr(ws.Cells(hdrRow, c).Value)), hdrText, vbTextCompare) = 0 Then
            FindHeaderColumn = c
            Exit Function
        End If
    Next c
    FindHeaderColumn = 0
End Function

Private Function IsEmail(s As String) As Boolean
    s = Trim$(s)
    IsEmail = (s Like "*?@?*.?*")
End Function

Private Function NormalizeEmails(s As String) As String
    Dim t As String
    t = Replace(Replace(Trim$(s), ",", ";"), " ", "")
    NormalizeEmails = t
End Function

Private Function LookupEmail(personName As String) As String
    On Error GoTo done
    Dim ws As Worksheet, f As Range
    Set ws = ThisWorkbook.Worksheets(DIR_SHEET)
    Set f = ws.Columns(1).Find(What:=personName, LookIn:=xlValues, LookAt:=xlWhole)
    If Not f Is Nothing Then LookupEmail = Trim$(CStr(f.Offset(0, 1).Value))
done:
End Function

Private Function ResolveRecipient(v As Variant) As String
    Dim txt As String: txt = Trim$(CStr(v))
    If Len(txt) = 0 Then Exit Function
    If InStr(txt, "@") > 0 Or IsEmail(txt) Then
        ResolveRecipient = txt
    Else
        ResolveRecipient = LookupEmail(txt)
    End If
End Function

Private Function BuildPlainTextBody(ws As Worksheet, r As Long) As String
    BuildPlainTextBody = _
        "This is your weekly automated reminder." & vbCrLf & vbCrLf & _
        "Workbook: " & ThisWorkbook.Name & vbCrLf & _
        "Sheet:    " & ws.Name & vbCrLf & _
        "Row:      " & r & vbCrLf & vbCrLf & _
        "Report:               " & CStr(ws.Cells(r, COL_REPORT).Text) & vbCrLf & _
        "Due Date (G):         " & CStr(ws.Cells(r, COL_DUE).Text) & vbCrLf & _
        "Regulatory Due (I):   " & CStr(ws.Cells(r, COL_REG_DUE).Text) & vbCrLf & _
        "Status (J):           " & CStr(ws.Cells(r, COL_STATUS).Text) & vbCrLf & _
        "Owner (L):            " & CStr(ws.Cells(r, COL_OWNER).Text) & vbCrLf & _
        "Reporting Agent (K):  " & CStr(ws.Cells(r, COL_AGENT).Text) & vbCrLf & vbCrLf & _
        "Please update Status to 'Completed' when done."
End Function

The provided VBA code automates the sending of email reminders through Microsoft Outlook for tasks in an Excel worksheet. Here's a breakdown of how it works:

Overall Purpose:

This script identifies tasks from a worksheet that meet certain criteria (e.g., tasks not yet completed, with due dates within a specific range) and sends email reminders to task owners and agents on a weekly basis (only on Mondays). It also keeps track of when reminders were last sent to avoid frequent notifications.

Key Components:

Configuration Section:
- Defines key constants, such as the sheet name (Tasks Individual), header row, and relevant column numbers for data like due dates, status, owners, and agents.
- Maps task statuses (e.g., Not Started, Completed).
- References the email directory sheet (EmailDirectory), which pairs people's names with their email addresses.
- Allows toggling between sending and previewing emails via the PREVIEW_EMAIL constant.
Main Routine: SendOwnerAgentReminders_WeeklyMonday():
- Runs Only on Mondays:
  - The macro exits immediately if the current day is not Monday.
- Validates and Prepares Worksheet:
  - Checks if the "Tasks Individual" worksheet and its columns are properly set up.
  - Ensures the presence of a "Last Notified" column to log when emails were sent last.
- Email Logic per Task:
  - Iterates through all rows (tasks) in the worksheet, starting from the second row (after the header).
  - Filters out tasks that:
    - Are marked as "Completed."
    - Don't have valid due dates.
    - Are outside the due date window (between the "Due Date" and "Regulatory Due Date").
    - Fall within the 7-day period after a previous notification.
  - Constructs email addresses for the task owner and reporting agent, resolving names into email addresses if necessary (via EmailDirectory).
- Composes and Sends Emails:
  - Builds a plain-text email body (describing the task contents) and sends emails to the relevant recipients using Microsoft Outlook.
  - Updates the "Last Notified" column with the current date for sent notifications.
  - Tracks and reports the number of emails sent.
- Error Handling:
  - Skips any rows or operations with invalid/missing data and gracefully handles Outlook object creation errors.
Helper Functions:
- FindHeaderColumn(): Finds the column index for a given column header.
- IsEmail(): Checks if a string is a valid email format (e.g., contains @).
- NormalizeEmails(): Removes extra spaces or converts commas to semicolons for proper email format.
- LookupEmail(): Searches the EmailDirectory worksheet for a recipient's name to retrieve their email.
- ResolveRecipient(): Returns an actual email address, either directly (if provided) or by resolving a name using LookupEmail().
- BuildPlainTextBody(): Constructs the plain text for the email body, detailing the task's relevant details (e.g., report name, due dates, status, owner, agent, etc.).

Key Logic in Filtering Tasks:

For each row in the task sheet:

Skip tasks where:
- The "Status" is empty or "Completed."
- Due dates are invalid or the current date (today) is outside the range between the "Due Date" and "Regulatory Due Date."
- The task was previously notified within the last 7 days.
Resolve the email addresses of the owner and reporting agent from the EmailDirectory, ensuring valid email format.
Send a reminder email for tasks that pass all these checks.

Outputs:

Email Sending:
- Sends individualized reminders with subject lines like:
```
Weekly Reminder: [Report Name] — Action Needed
```
- Email body summarizes task details, like due dates, owner, agent, and includes instructions to update the status of the task.
Tracking Notifications:
- Updates the "Last Notified" column with the current date for each task that was emailed.
Summary Message:
- After execution, displays a message box indicating how many reminders were sent (e.g., "5 weekly reminder(s) sent.").

Use Case:

This code is useful for organizations or project managers who need to automate task follow-ups. It ensures weekly notifications are sent to the right people (owners/agents) at the right time, reducing manual oversight.

Generate your own explanations

Download our vscode extension

Read other generated explanations

Built by @thebuilderjr