Get excel 2010 to send auto e-mail

Hello,

I have a spreadsheet that i track my vendors certificate of insuranse expiration dates on. i am wanting excel to send me an automatic e-mail when a formula cell i have created that tells me their COI expires in less than 30 days turn to "YES". I have got this to work in the past, but it would send duplicate e-mails on vendors that it sent the day before. i only want it to send me ones that have just changed. the formula i used before got erased somehow. below you will see what columns i have what in. I have a column with the e-mail address i want the e-mail sent to. in the e-mail i would like the subject to say "COI ABOUT TO EXPIRE". In the body i would like it to say "(Vendor Name in Column A) COI will expire in less than 30 days. Please contact them using (e-mail address is Column AU) or (Phone number in Column AV) to get an updated copy."

Column info:

Column A-Vendor Name
Column AO- Expiration Date
Column AP- formula working off of Column AO information telling me if it expires in less than 30 days.
Column AQ-Email address i would like the e-mail sent to.
Column AU-Vendor e-mail adress i would like in the e-mail body
Column AV- Vendor phone number i would like in the e-mail body






Below is the formula i am trying to use but i will not work:


Sub SendMail()
Dim OutApp As Object
Dim OutMail As Object
Dim EMS As Range
Dim lastRow As Long
Dim dateCell, dateCell1 As Date

Application.ScreenUpdating = False
Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon
lastRow = Range("A" & Rows.Count).End(xlUp).Row
On Error GoTo cleanup
For Each EMS In Range("AP4:AP" & lastRow)
If EMS = "YES" Then
dateCell = EMS.Value
dateCell1 = Cells(EMS.Row, "AP").Value
If dateCell <> dateCell1 Then
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = Cells(EMS.Row, "AQ").Value
.Subject = "COI ABOIT TO EXPIRE"
.Body = "VENDOR " & Cells(EMS.Row, "A").Value _
& vbNewLine & vbNewLine & _
"COI EXPIRES IN 30 DAYS OR LESS PLEASE CONTACT THEM TO RENEW " & Cells(EMS.Row, "AU,AV").Value & _
vbNewLine & vbNewLine _
& vbNewLine & vbNewLine & _
"THANKS," & vbNewLine & _
"MSA LIST"
.send
End With
On Error GoTo 0
Set OutMail = Nothing
End If
Cells(EMS.Row, "AP").Value = "NO"
EMS.ClearContents
End With
Set OutApp = Nothing
Application.ScreenUpdating = True
End Sub


Please Help
Thanks