Automatic Email Reminder

Need email sent automatically when date is entered in any independent cell in column E3:E45.

Option Explicit

Sub email()

 Dim r As Range
    Dim cell As Range

    Set r = Range("E3:E45")

    For Each cell In r

        If cell.Value = Date Then

            Dim Email_Subject, Email_Send_From, Email_Send_To, _
            Email_Cc, Email_Bcc, Email_Body As String
            Dim Mail_Object, Mail_Single As Variant

            Email_Subject = "Trucks Due for B Service"
            Email_Send_From = ".com"
            Email_Send_To = ".com"
            Email_Cc = ""
            Email_Bcc = ""
            Email_Body = "body"

            On Error GoTo debugs
            Set Mail_Object = CreateObject("Outlook.Application")
            Set Mail_Single = Mail_Object.CreateItem(0)
            With Mail_Single
            .Subject = Email_Subject
            .To = Email_Send_To
            .cc = Email_Cc
            .BCC = Email_Bcc
            .Body = Email_Body
            .send
            End With

        End If

    Next


    Exit Sub

debugs:
        If Err.Description <> "" Then MsgBox Err.Description
End Sub

Open in new window

(Edit: Added CODE tags)
Nestle-Water-B-Service-Master-Testi.xlsm
Enrique A. Santos KM4ZQCCustomer Service RepresentativeAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

byundtMechanical EngineerCommented:
I assume you want a separate email sent for each date entered in E3:E45--and only when those dates are entered. I therefore modified your email sub to receive a range parameter.

I also modified your Dim statement (you must declare each variable as something as shown--otherwise the variable is a Variant.

Finally, I modified your error handling to eliminate the need for an Exit Sub statement.
Sub email(cell As Range)
    Dim Email_Subject, Email_Send_From As String, Email_Send_To As String, Email_Cc As String, Email_Bcc As String, Email_Body As String
    Dim Mail_Object, Mail_Single As Variant

    If cell.Value = Date Then
        Email_Subject = "Trucks Due for B Service"
        Email_Send_From = "hanksantos@hotmail.com"
        Email_Send_To = "hanksantos@hotmail.com"
        Email_Cc = ""
        Email_Bcc = ""
        Email_Body = "body"
    
        On Error GoTo debugs
        Set Mail_Object = CreateObject("Outlook.Application")
        Set Mail_Single = Mail_Object.CreateItem(0)
        With Mail_Single
            .Subject = Email_Subject
            .To = Email_Send_To
            .cc = Email_Cc
            .BCC = Email_Bcc
            .Body = Email_Body
            .send
        End With
    
    End If

debugs:
    If Err <> 0 Then
        If Err.Description <> "" Then MsgBox Err.Description
        Err.Clear
    End If
    On Error GoTo 0
End Sub

Open in new window

To get the code to run automatically, you need a Worksheet_Change event sub to call the modified email sub. The Worksheet_Change event sub must go in the code pane for the worksheet being watched. If you put it anywhere else, it will not work!
Private Sub Worksheet_Change(ByVal Target As Range)
Dim cel As Range, targ As Range
Set targ = Range("E3:E45")  'Watch these cells for changes

Set targ = Intersect(targ, Target)
If Not targ Is Nothing Then
    For Each cel In targ.Cells
        If cel.Value <> "" Then email cel
    Next
End If
End Sub

Open in new window

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
byundtMechanical EngineerCommented:
It is worth noting that statement 5 in sub email tests the value in the cell passed to the sub against today's date. If they match, then the email is sent. If they do not match, nothing occurs.

If instead you want the email to be sent if there is any valid date in the cell, then you need to change statement 5 to:
If IsDate(cell.Value) Then

Open in new window

Enrique A. Santos KM4ZQCCustomer Service RepresentativeAuthor Commented:
Please check.  Code runs but is not emailing automatically.


Private Sub Worksheet_Change(ByVal Target As Range)
Dim cel As Range, targ As Range
Set targ = Range("E3:E45")  'Watch these cells for changes

Set targ = Intersect(targ, Target)
If Not targ Is Nothing Then
    For Each cel In targ.Cells
        If cel.Value <> "" Then email cel
    Next
End If
End Sub

Sub email(cell As Range)
    Dim Email_Subject, Email_Send_From As String, Email_Send_To As String, Email_Cc As String, Email_Bcc As String, Email_Body As String
    Dim Mail_Object, Mail_Single As Variant

    If IsDate(cell.Value) Then
        Email_Subject = "Trucks Due for B Service"
        Email_Send_From = "enrique_delossanto@swifttrans.com"
        Email_Send_To = "enrique_delossanto@swifttrans.com"
        Email_Cc = ""
        Email_Bcc = ""
        Email_Body = "body"
   
        On Error GoTo debugs
        Set Mail_Object = CreateObject("Outlook.Application")
        Set Mail_Single = Mail_Object.CreateItem(0)
        With Mail_Single
            .Subject = Email_Subject
            .To = Email_Send_To
            .cc = Email_Cc
            .BCC = Email_Bcc
            .Body = Email_Body
            .send
        End With
   
    End If

debugs:
    If Err <> 0 Then
        If Err.Description <> "" Then MsgBox Err.Description
        Err.Clear
    End If
    On Error GoTo 0
End Sub
byundtMechanical EngineerCommented:
I apologize for attaching the wrong workbook to my previous Comment. I subsequently removed it to avoid confusion if somebody else should look at this thread.

Most likely, the failure of the code to run automatically is caused by putting the Worksheet_Change sub in the wrong location. Rightclick the sheet tab, and choose View code... from the resulting dialog. The resulting code pane is where the Worksheet_Change sub has to go.

I revised the email sub slightly because I noticed that Mail_Object hadn't been declared properly. I also updated the email addresses.
Sub email(cell As Range)
    Dim Email_Subject, Email_Send_From As String, Email_Send_To As String, Email_Cc As String, Email_Bcc As String, Email_Body As String
    Static Mail_Object As Object
    Dim Mail_Single As Object

    If IsDate(cell.Value) Then
        Email_Subject = "Trucks Due for B Service"
        Email_Send_From = "enrique_delossanto@swifttrans.com"
        Email_Send_To = "enrique_delossanto@swifttrans.com"
        Email_Cc = ""
        Email_Bcc = ""
        Email_Body = "body"
    
        On Error GoTo debugs
        If Mail_Object Is Nothing Then Set Mail_Object = CreateObject("Outlook.Application")
        Set Mail_Single = Mail_Object.CreateItem(0)
        With Mail_Single
            .Subject = Email_Subject
            .To = Email_Send_To
            .cc = Email_Cc
            .BCC = Email_Bcc
            .Body = Email_Body
            .send
        End With
    
    End If

debugs:
    If Err <> 0 Then
        If Err.Description <> "" Then MsgBox Err.Description
        Err.Clear
    End If
    On Error GoTo 0
End Sub

Open in new window

Nestle-Water-B-Service-MasterQ28997.xlsm
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
R

From novice to tech pro — start learning today.