Excel Code to Send/Not Send Email Based on Date

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