Automated Email in Excel

Hi All,

I have a spread that generates an automatic email when a contract is due to end.

Currently, if the contract is due to end in the next 20 days an email will be generated.

I would really like to set this up so that I can generate a second email detailing that it is URGENT if the contract is due to end in 10 day.

I have attached my spread to this sheet.

If you can help I would be so appreciative.

Alice :-)

Sub CheckForExpiryDates()

Dim Cell As Range
Dim ExpiryDate As Date
Dim Mail_Msg As String
Dim Mail_Subj As String
Dim Mail_USubj As String
Dim Rng As Range
Dim RngEnd As Range
Dim lngDateSpread As Long

Mail_Subj = "Training"
Mail_USubj = "URGENT: Training"


Set Rng = Worksheets("Sheet1").Range("A2")
Set RngEnd = Rng.Parent.Cells(Rows.Count, Rng.Column).End(xlUp)
Set Rng = IIf(RngEnd.Row < Rng.Row, Rng, Rng.Parent.Range(Rng, RngEnd))

For Each Cell In Rng.Cells
ExpiryDate = Cell.Offset(0, 2)
lngDateSpread = DateDiff("d", Now(), ExpiryDate)
If Cell.Offset(0, 3) = "" Then
Select Case DateDiff
Case Is <= 10
Mail_Msg = Cell.Value & "'s Contract is due to expire on " & ExpiryDate & vbCrLf _
& "please advise on extension"
SendEmail Cell.Offset(0, 1), Mail_Subj, Mail_Msg
Cell.Offset(0, 3) = Now()
Case 11 To 20
Mail_Msg = Cell.Value & "'s Contract is due to expire on " & ExpiryDate & vbCrLf _
& "please advise on extension"
SendEmail Cell.Offset(0, 1), Mail_USubj, Mail_Msg
Cell.Offset(0, 3) = Now()
Case Else 'do nothing
End Select
End If
Next Cell

End Sub

It says that the arguement is not optional and highlights the datediff I have enlarged above.

Thanks!

This seems to be working perfectly now!! Thanks so much. I am going to fiddle more and will report back any errors.

Many Thanks!