Automate e-mail notification and macro + include cell values

[david91]

Hi,

I am currently working on a sheet, where I wish to achieve the following:

• Whenever one or multiple items with status (Column E) In Progress and Awaiting info (ONLY!), has been in the sheet for exactly 7 or 14 days, I receive an e-mail notification which lists the items in the e-mail body (Column H - cell value)
• In the e-mail body, I only want the cells in Column H, where the Cells shows that the function is TRUE (ergo, shows value > 0 and is not blank) (in the example below, only H2 and H4 to appear in the e-mail).
• E-mail should only be sent if any of the Cells in Column H is NOT blank.
• Only one e-mail to be sent per day max. Eg. if I open the workbook in the morning, and the e-mail get's sent out, it will not be sent again if someone opens the file evening.
• The macro to automatically run once I open the workbook (e-mail to also send by itself once opened, but only once per day!)

I have the following sheet (name: "E-mail test") (let's take 09-May-2018 as today's date):

	A	B	C	D	E	F	G	H
1	Comp. Nr	Comp. Name	Comp type	Date rec'd	Status	14 days	7 days	E-mail body
2	101	A	1	02-May-18	In Progress		7	101 A 1 - 7 Days
3	102	B	3	20-Apr-18	Completed
4	103	C	2	25-Apr-18	Awaiting info	14		103 C 2 - 14 Days
5	104	D	1	01-May-18	In Progress
6	105	E	3	17-Nov-17	Completed

<tbody>
</tbody>

Please note that Column F-H are all hidden columns with the following functions which works perfectly:

• F: =IF(E2="Completed","",IF(AND(D2>0,OR(E2="Awaiting info",E2="In progress")),IF(TODAY()-D2=14,"14",""),""))
• G: =IF(E2="Completed","",IF(AND(D2>0,OR(E2="Awaiting info",E2="In progress")),IF(TODAY()-D2=7,"7",""),""))
• H: =IF(OR(F2="14",G2="7"),CONCATENATE(A2," ",B2," ",C2," ","-"," ",F2,G2," ","days"),"")

So far, I have the following code in VBA:

Dim xRg As Range​

Private Sub Worksheet_Change(ByVal Target As Range)​

On Error Resume Next​

If Target.Cells.Count > 1 Then Exit Sub​

Set xRg = Intersect(Range("H2:H6"), Target)​

If xRg Is Nothing Then Exit Sub​

If IsNumeric(Target.Value) And Target.Value > 0 Then​

Call Mail_small_Text_Outlook​

End If​

End Sub​

Sub Mail_small_Text_Outlook()​

Dim xOutApp As Object​

Dim xOutMail As Object​

Dim xMailBody As String​

Set xOutApp = CreateObject("Outlook.Application")​

Set xOutMail = xOutApp.CreateItem(0)​

xMailBody = "Please note that the following item(s) has been pending for (more than) 7 or 14 days," & vbNewLine & _​

"and requires action or follow up:"​

On Error Resume Next​

With xOutMail​

.To = "email@email.com"​

.CC = ""​

.BCC = ""​

.Subject = "ACTION REQUIRED! Pending items"​

.Body = xMailBody​

.Send 'or use .Display​

End With​

On Error GoTo 0​

Set xOutMail = Nothing​

Set xOutApp = Nothing​

End Sub​

I am now stuck with my goals listed above, and would appreciate all help I could get.
Please let me know if further clarifications are needed.

Many thanks.