Sending overdue email alerts based on dates in multiple columns

[Cookey5599]

Good afternoon and apologies of this has already been asked but I cant find a thread that details this particular issue.

We have a supplier approval log that shows when a particular certificate expires, as you can see form the attachment it is possible that one supplier could hold multiple certs with multiple expiry dates.

I have amended the following code so that it checks column V and sends an email accordingly, what I cant seem to do is get it to check the other cells (n,r,aa & af)


Private Sub Workbook_Open()
Dim OutApp As Object
Dim OutMail As Object
Dim lLastRow As Long
Dim lRow As Long
Dim sSendTo As String
Dim sSendCC As String
Dim sSendBCC As String
Dim sSubject As String
Dim sTemp As String

Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon

' Change the following as needed
sSendTo = "test@company.com"
sSendCC = ""
sSendBCC = ""
sSubject = "Due date reached"

lLastRow = Cells(Rows.Count, 3).End(xlUp).Row
For lRow = 2 To lLastRow
If Cells(lRow, 23) <> "S" Then
If Cells(lRow, 22) <= Date Then
Set OutMail = OutApp.CreateItem(0)

On Error Resume Next
With OutMail
.To = sSendTo
If sSendCC > "" Then .CC = sSendCC
If sSendBCC > "" Then .BCC = sSendBCC
.Subject = sSubject

sTemp = "Hi Luke" & vbCrLf & vbCrLf
sTemp = sTemp & "The Quality ceritifcate has expired "
sTemp = sTemp & "for this supplier:" & vbCrLf & vbCrLf
' supplier name is in column F
sTemp = sTemp & " " & Cells(lRow, 6) & vbCrLf & vbCrLf
sTemp = sTemp & "Please take the appropriate "
sTemp = sTemp & "action." & vbCrLf & vbCrLf
sTemp = sTemp & "BR" & vbCrLf

.Body = sTemp
' Change the following to .Send if you want to
' send the message without reviewing first
.Display
End With
Set OutMail = Nothing

Cells(lRow, 23) = "S"
Cells(lRow, 24) = "E-mail sent on: " & Now()
End If
End If
Next lRow
Set OutApp = Nothing
End Sub



If anyone has any suggestions then I would be eternally grateful.

Thanks

 

[Domenic]

To check whether any of the target cells has a date earlier than or equal to today's date, try replacing . . .

If Cells(lRow, 22) <= Date Then

with

If Cells(lRow, "v") <= Date Or Cells(lRow, "n") <= Date Or Cells(lRow, "r") <= Date Or Cells(lRow, "aa") <= Date Or Cells(lRow, "af") <= Date Then

Hope this helps!

 

[Cookey5599]

Hi and thanks for coming back to me,

I plugged this in but oddly it just causes the spreadsheet to send emails for all of the suppliers in column V regardless of whether they are overdue are not

 

[Domenic]

Actually, we need to check to make sure that the cell isn't blank before testing whether the date meets the criteria . . .

If (Len(Cells(lRow, "v")) > 0) And (Cells(lRow, "v").Value <= Date) Or _
    (Len(Cells(lRow, "n")) > 0) And (Cells(lRow, "n").Value <= Date) Or _
    (Len(Cells(lRow, "r")) > 0) And (Cells(lRow, "r").Value <= Date) Or _
    (Len(Cells(lRow, "aa")) > 0) And (Cells(lRow, "aa").Value <= Date) Or _
    (Len(Cells(lRow, "af")) > 0) And (Cells(lRow, "af").Value <= Date) Then

Does this help?