Send email if today's date is within four days of a due date

Question

I would definitely be considered a vba beginner, and I am trying to build into my project management spreadsheet an automatic email reminder when today's date falls within 4 days of a due date. But the code I'm using keeps returning a runtime error 13: type mismatch.

I have searched the hallowed halls of the entire internet looking for this solution but nothing seems to match my specific problem, or maybe I'm just having trouble applying the principles in other posts to this specific code.

Here is the code.

Option Explicit

Sub email()

    Dim r As Range
    Dim cell As Range

    Set r = Range("D4:D154")

    For Each cell In r

    If r.Value <= (Date + 4) And r.Value >= (Date + 0) Then

        Dim Email_Subject, Email_Send_From, Email_Send_To, _
        Email_Cc, Email_Bcc, Email_Body As String
        Dim Mail_Object, Mail_Single As Variant

        Email_Subject = ActiveCell(0, 2) & ActiveCell(0, -2) & "is due"
        Email_Send_From = "me@domain.com"
        Email_Send_To = Cells(1, 11)
        Email_Body = "This is an automated reminder to update BSA Project Manager on your project."

        On Error GoTo debugs
        Set Mail_Object = CreateObject("Outlook.Application")
        Set Mail_Single = Mail_Object.CreateItem(0)
        With Mail_Single
        .Subject = Email_Subject
        .To = Email_Send_To
        .Body = Email_Body
        .send
        End With

    End If

Next

The error is being returned on the If r.value <= (date+4) line. I included the entire code both for context and for if anyone in passing sees anything else I did that was wrong, that it may be pointed out if you are so inclined.

I have attempted to use DateDiff as well with the same result. I'm thinking that maybe I shouldn't set Dim r as Range, or maybe I should be using some language to let excel know that what is in each cell in the D column is a date so that the data types match.

Forgive me if this is an idiot question.

Answer 1

Cleaning up and simplifying this code a bit - here are a few points to consider:

• When declaring variables one after the other, you need to specify their type for each of the variables declared: Dim Email_Subject As String, Dim Email_Send_From As String, etc. - otherwise only the last is declared As String and the rest are Variant s.
• It's best practice to explicitly declare which Workbook and Worksheet you are working with when referencing a Range - so specify which worksheet Range("D4:D154") is on.
• Your TYPE MISMATCH error is from trying to compare r.Value to (Date + 4) , instead of cell.Value - you're looping through each cell after all.
• Instead of using ActiveCell in your loop, just use cell and then Offset to refer to a column to the right or to the left.

So your modified code might look something like this: (UNTESTED)

Sub email()
    Dim r As Range, cell As Range
    Dim ws As Worksheet
    Dim Mail_Object As Object, Mail_Single As Object
    Dim Email_Subject As String, Email_Send_From As String, Email_Send_To As String, _
        Email_Cc As String, Email_Bcc As String, Email_Body As String

    Set ws = ThisWorkbook.Worksheets("Sheet1") ' change to your sheet name
    Set r = ws.Range("D4:D154")
    Set Mail_Object = CreateObject("Outlook.Application")

    For Each cell In r
        If cell.Value <= (Date + 4) And cell.Value >= (Date) Then

            Email_Subject = cell.Offset(, 1).Value & cell.Offset(, -1).Value & "is due"
            Email_Send_From = "me@domain.com"
            Email_Send_To = ws.Cells(1, 11).Value
            Email_Body = "This is an automated reminder to update BSA Project Manager on your project."

            On Error GoTo debugs
            Set Mail_Single = Mail_Object.CreateItem(0)

            With Mail_Single
                .Subject = Email_Subject
                .To = Email_Send_To
                .Body = Email_Body
                .Send
            End With

        End If
    Next cell
    '... more code
End Sub