Selected Answer
Lisbeth
Please find attached my version of your file. The code below currently creates draft emails for the 26 leads where there's a date in column H which earlier than today (see the first line in bold in the code, a test inside a simple loop)- that's like what your purple conditional formatting does.
The sub is located in new Module1 so could be run from any sheet (you need to do that manually at present but you could assign it to a button or move it). The first test stops you running it on a new sheet I've added, called EmailBoilerplate (but you can change that without affecting the code and tweak the wording in the cells which get used in the emails).
The code calls on a function called RangetoHTML(Rng As Range) to convert the header and lead row into HTML- that's created by VBA guru Ron de Bruin and available on the interent if you search- I haven't listed it in this answer but credit to him.
Private Sub ReminderEmails()
Dim OutApp As Object
Dim OutMail As Object
Dim n As Integer
Dim SendRows As Range
On Error Resume Next
If ActiveSheet.Name = Sheet1.Name Then ' don't run from boilerplate sheet
MsgBox "Please select run from data sheet instead"
Exit Sub
Else
MsgBox "Please wait while emails are created (in Outlook's Drafts folder)"
End If
Application.ScreenUpdating = False
Set OutApp = CreateObject("Outlook.Application")
For n = 3 To Cells(Rows.Count, 1).End(xlUp).Row 'check all rows where there's a value in column A
If Range("H" & n) < Date And Range("H" & n) <> "" Then ' check if it's due or late c.f. today
Set OutMail = OutApp.CreateItem(olMailItem)
Set SendRows = Union(Range("A2:I2"), Range("A" & n & ":I" & n)) ' pick header row and lead row
With OutMail
.To = Range("F" & n)
.CC = ""
.Subject = Sheet1.Range("A4") & Range("C" & n)
.HTMLBody = RangetoHTML(Sheet1.Range("A10, A13")) & RangetoHTML(SendRows) 'call function to convert rows
'.Display
.Save
'.Send
.Close
End With
'Range("I" & n) = Range("I" & n) + " Reminder email sent " & Date & "."
End If
Next n
Set OutMail = Nothing
Set OutApp = Nothing
Application.ScreenUpdating = True
MsgBox "Done!"
End Sub
Currently the code just saves a draft but (once you have valid email addresses from row 16 down) you could change the email actions (in bold) to just send, by uncommenting .Send (or . Display if you want them all to appear on screen when created).
The code could then add a note about the emails to the text in column I - you'd need to uncomment the line in bold near the end of the loop: Range("I" & n) = Range("I" & n) + " Reminder email sent " & Date & "."
Hope this is what you need. Happy New Year!