Get Excel to send an automatic email based on an end date

[Anakin89]

good day,

I am a very basic user and am trying to find a code to only send to a single email address (located in R1) using outlook based on all data in a spread sheet to let a supervisor know before someone returns. I would like this to be sent out -7 days prior to "End Date" in (column J). I also need to have the code automatically change the color in (column J) to blue after the email is sent so that it will not resend every time the spread sheet is opened and automatically save after the code completes. Please highlight the areas I need to fill in.

I need the email to read:
"Subject "Member Return"
"Title"
"Member Name (column E+F) is returning from (column L) on (column J)
Thanks,
NAME
Department

Thanks,
Mitch

 

[breynolds0431]

Hello. Try adding the below to a regular module and update all variables where indicated.

Sub SendEMail()

Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("LeaveList") '<- Change sheet name to suit
Dim frow As Integer: frow = 3 'First row of data, change to suit
Dim xCol As Integer: xCol = 10 'Column with end dates (i.e.; 10 = col. J)
Dim lrow As Long: lrow = ws.Cells(ws.Rows.Count, 10).End(xlUp).Row 'Determines last row in xCol
Dim c As Range

Dim oLook As Object, eMail As Object
Dim sTo As String: sTo = ws.Range("R1").Value
Dim sTitle As String: sTitle = "Add Recipient's Title" '<- Indicate desired title here
Dim mName As String, rReason As String, rDate As Date, sName As String, sDept As String

For Each c In ws.Range(ws.Cells(frow, xCol), ws.Cells(lrow, xCol))
    If c.Value = Date - 7 And Not c.Interior.Color = vbBlue Then
        Set oLook = CreateObject("Outlook.Application")
        Set eMail = oLook.createItem(0)
        mName = ws.Cells(c.Row, 5).Value & " " & ws.Cells(c.Row, 6).Value 'Member's full name
        rReason = ws.Cells(c.Row, 12).Value 'Returns reason from column L
        rDate = ws.Cells(c.Row, 10) 'Returns date from column J
        sName = "Add Sender's Name" '<- Indicate desired sender's name here
        sDept = "Add Sender's Department" '<- Indicate desired sender's department here
        With eMail
            .To = sTo
            .Subject = "Member Return"
            .HTMLBOdy = sTitle & "<br>" & "<br>" & "Member name " & mName & _
                " is returning from " & rReason & " on " & rDate & "." & "<br>" &  _
                "<br>" & "Thanks, " & "<br>" & sName & "<br>" & sDept
            .display 'or change to .send
        End With
        c.Interior.Color = vbBlue 'changes date cell to blue
    End If
    Set eMail = Nothing
    Set oLook = Nothing
Next c