Run a macro automatic when a specific formula cells reache a certain date (current date)

[klkarlsem]

Hi,

I'm trying to get excel to run a macro that sends me an email when certain cells reach specific dates (current date and one week prior to current date). I've tried following the steps on Send a mail when a cell reaches a certain value but it doesn't work. I need excel to send me an email when the cell formulas in columns A and B, "=D2<TODAY()" and "=E2<TODAY()" respectively, are TRUE.

FYI:
D2: =WORKDAY.INTL(E2;-5) --> 5 days prior to E2
E2: A specific set date

K

 

[Stiuart_W]

What do you mean by "It doesn't work"?

What isn't working? - Does the Worksheet Change event code not correctly capture when your criteria is reached (IE it NEVER tries to send a mail), or does the code reach the mail sending part but it doesn't send?


Please attach your code, explain the problem you are having and give details of your e-mail client

 

[klkarlsem]

What do you mean by "It doesn't work"?

What isn't working? - Does the Worksheet Change event code not correctly capture when your criteria is reached (IE it NEVER tries to send a mail), or does the code reach the mail sending part but it doesn't send?


Please attach your code, explain the problem you are having and give details of your e-mail client

-----------------------------
I get emails, but only when I manually update the sheet/run macros (Alt+F8). BUT I'm not sure on what criterias I get these emails. I believe that the cell formating is correct, and that it is the code that is wrong - that its not picking up on when to send out emails. I have no experience with macros, I've never used them before, so I have no idea if it's correct!

Code:

Option Explicit
Private Sub Worksheet_Calculate()
Dim FormulaRange As Range
Dim NotSentMsg As String
Dim MyMsg As String
Dim SentMsg As String
Dim MyLimit As Double


NotSentMsg = "Not Sent"
SentMsg = "Sent"


'Above the MyLimit value it will run the macro
MyLimit = D2 < TODAY() = True


'Set the range with Formulas that you want to check
Set FormulaRange = Me.Range("A2:A50;B2:B50")


On Error GoTo EndMacro:
For Each FormulaCell In FormulaRange.Cells
With FormulaCell
If IsNumeric(.Value) = False Then
MyMsg = "Not numeric"
Else
If .Value > MyLimit Then
MyMsg = SentMsg
If .Offset(0, 1).Value = NotSentMsg Then
Call Mail_with_outlook2
End If
Else
MyMsg = NotSentMsg
End If
End If
Application.EnableEvents = False
.Offset(0, 1).Value = MyMsg
Application.EnableEvents = True
End With
Next FormulaCell


ExitMacro:
Exit Sub


EndMacro:
Application.EnableEvents = True


MsgBox "Some Error occurred." _
& vbLf & Err.Number _
& vbLf & Err.Description


End Sub
Sub Mail_small_Text_Outlook()
Dim OutApp As Object
Dim OutMail As Object
Dim strbody As String
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
strbody = "Varsel om uttak" & vbNewLine & vbNewLine & _
"Sjekk uttaksplan, et uttak nærmer seg" & vbNewLine & _
"Link til uttaksplan: "
On Error Resume Next
With OutMail
.To = "kristine.karlsen@ge.com"
.CC = ""
.BCC = ""
.Subject = "Varsel om uttak"
.Body = strbody
.Send
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End Sub