Excel Code to Send/Not Send Email Based on Date

[Diana703]

I need to insert code into my existing macro that will send email based on two things:  1) If Cell P (Email Sent) has a date in it, don't send any email; 2) Send only email if Cell O (Review Date) is within 120 days prior to the date in Cell O.  Below is the code I have so far.  I've attached the spreadsheet also.  Can anyone help me with this?  Thanks so much.

Sub Button1_Click()
Dim rngCell As Range
Dim Rng As Range
Dim OutApp As Object
Dim OutMail As Object
Dim strBody As String
Dim EmailSubject As String
Dim SendToMail As String
Dim r As Long
With ActiveSheet
If .FilterMode Then .ShowAllData
End With
Set OutApp = CreateObject("Outlook.Application")
Set Rng = Range("AH5", Cells(Rows.Count, "AH").End(xlUp))
For Each rngCell In Rng
r = rngCell.Row
Range("P" & r).Value = Date
Set OutMail = OutApp.CreateItem(0)
strBody = "According to my records, your " & Range("A" & r).Value & _
" contract is due for review. This contract expires " & Range("Q" & r).Value & _
". It is important you review this contract ASAP and email me " & _
"with any changes that are made. If it is renewed or rolled over, please fill out the " & _
"Contract Cover Sheet which can be found in the Everyone folder " & _
"and send me the Contract Cover Sheet along with the new original contract."
SendToMail = Range("AH" & r).Value
EmailSubject = Range("A" & r).Value
On Error Resume Next
With OutMail
.To = SendToMail
.CC = "email address removed for privacy reasons"
.BCC = ""
.Subject = EmailSubject
.Body = strBody
.Display ' You can use .Send
End With
Application.ScreenUpdating = False
'End If
Next rngCell
Application.ScreenUpdating = True
End Sub

[#2]

@Diana703 

"Send only email if Cell O (Review Date) is within 120 days prior to the date in Cell O" cannot be correct. What should it be?

[#3]

You've got to be so tired of me! Bless your heart.
What I need is for it to not send an email if there is already a date in Email Sent in Column P (that is the date that is put in automatically when the email goes out) but to send the email for the cells that are empty (no date in them). At the same time, I need for it to only send emails to those where the Expiration Date in Column Q is a max of 120 days prior to that date. So you see, it has two conditions that need to be met prior to sending the email.
You are such a wonderful person. I'm embarrassed that I'm bothering you again but thank you for all you are doing.

[#4]

@Diana703 

You write "where the Expiration Date in Column Q is a max of 120 days prior to that date."

What is that date? The date in column O?

[#5]

@Diana703 

Try this:

Sub Button1_Click()
    Dim rngCell As Range
    Dim Rng As Range
    Dim OutApp As Object
    Dim OutMail As Object
    Dim strBody As String
    Dim EmailSubject As String
    Dim SendToMail As String
    Dim r As Long
    Application.ScreenUpdating = False
    With ActiveSheet
        If .FilterMode Then .ShowAllData
    End With
    Set OutApp = CreateObject("Outlook.Application")
    Set Rng = Range("AH5", Cells(Rows.Count, "AH").End(xlUp))
    For Each rngCell In Rng
        r = rngCell.Row
        If Range("P" & r).Value = "" And Range("Q" & r).Value <> "" And Range("O" & r).Value >= Range("Q" & r).Value - 120 Then
            Range("P" & r).Value = Date
            Set OutMail = OutApp.CreateItem(0)
            strBody = "According to my records, your " & Range("A" & r).Value & _
                " contract is due for review. This contract expires " & Range("Q" & r).Value & _
                ".  It is important you review this contract ASAP and email me " & _
                "with any changes that are made.  If it is renewed or rolled over, please fill out the " & _
                "Contract Cover Sheet which can be found in the Everyone folder " & _
                "and send me the Contract Cover Sheet along with the new original contract."
            SendToMail = Range("AH" & r).Value
            EmailSubject = Range("A" & r).Value
            On Error Resume Next
            With OutMail
                .To = SendToMail
                .CC = "email address removed for privacy reasons"
                .BCC = ""
                .Subject = EmailSubject
                .Body = strBody
            .Display ' You can use .Send
            End With
        End If
    Next rngCell
    Application.ScreenUpdating = True
End Sub

[#6]

Both of these dates vary. The Review Date (Column O) is automatic with a simple formula (=Q5-120). The Expiration Date (Column Q) varies for each contract.

[#7]

It's still giving me the email for the contract that doesn't expire until 9/13/23. It should ignore that one until its 120 days prior to that date.

[#8 · Accepted solution]

@Diana703 

I was misled by your description. Change the line

        If Range("P" & r).Value = "" And Range("Q" & r).Value <> "" And Range("O" & r).Value >= Range("Q" & r).Value - 120 Then

to

        If Range("P" & r).Value = "" And Range("Q" & r).Value <> "" And Range("O" & r).Value <= Date Then

[#9]

It works! How can I ever repay you for all the help you've given me...I could not have ever done this without your help. You are a good man and I wish I could meet you one day. Take care my friend, stay safe, and God bless you.