Send Email on cell change works..BUT..

[Akashwani]

Good day,

I am sending an email when the value of a cell changes, http://www.rondebruin.nl/mail/change.htm
I am using the following code in my worksheet....

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rng As Range
    If Target.Cells.Count > 1 Then Exit Sub
    On Error GoTo EndMacro
    If Not Target.HasFormula Then
        Set rng = Target.Dependents
        If Not Intersect(Range("AE7"), rng) Is Nothing Then
            If Range("AE7").Value < 20 Then EmailOut 'MyMacroName
    End If
    End If
EndMacro:
End Sub

My Macro code..

Sub EmailOut ()    
    Dim OutApp As Object
    Dim OutMail As Object
    Dim strto As String, strcc As String, strbcc As String
    Dim strsub As String, strbody As String
 
    Set OutApp = CreateObject("Outlook.Application")
    OutApp.Session.Logon
    Set OutMail = OutApp.CreateItem(0)
 
    strto = "[EMAIL="Ak@XYZ.com"]Ak@XYZ.com[/EMAIL]"
    strcc = ""
    strbcc = ""
    strsub = "Testing email send"
    strbody = "Using EmailOut" & vbNewLine & vbNewLine & _
              "Cell AE7 has changed"
 
    With OutMail
        .To = strto
        .CC = strcc
        .BCC = strbcc
        .Subject = strsub
        .Body = strbody
        .Send
    End With
 
    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub

What I would like to do is increase the range that this applies to.
Range from AE7 to Range Y3:AE250.
I would like to Include the Range A3:A250 in the subject/body.

So If AE7 has changed, A7 (along with some text "This cell has changed, do X Y Z") would be somewhere within the email.

I hope that is clear and possible!

Ak

 

[Akashwani]

Oh Peter, Peter where have you been for the past 2 weeks?

That seems to work a treat
thank you so very much for your help once again.

Now this is only an IF..
but, if I wanted to open the workbook, without going to the particular sheet that this post relates to, what would I put in the workbook open event to have this run?

Once again Peter, thank you very much, you really are an Excel star.

Ak

 

[VoG]

Here's your chance to do some groundbreaking research

I'm pretty sure that provided calculation is set to automatic then each worksheet will recalculate when you open the workbook. Assuming that to be the case try this in the ThisWorkbook module (change Sheet1 to suit).

Private Sub Workbook_SheetCalculate(ByVal Sh As Object)
Dim c As Range
If Sh.Name = "Sheet1" Then
    For Each c In Sh.Range("Y3:AE250")
        If c.Value = 20 Then
            Call EmailOut
            Exit For
        End If
    Next c
End If
End Sub

 

[Akashwani]

I guess this really is ground breaking.

Fricking eck Peter that was about to send out 1700+ emails

I managed to stop it at 50

Is the "Next c" part causing this?

Ak

 

[VoG]

Not quite sure why that is happening but try

Private Sub Workbook_SheetCalculate(ByVal Sh As Object)
Dim c As Range
If Sh.Name = "Sheet1" Then
    For Each c In Sh.Range("Y3:AE250")
        If c.Value = 20 Then
            Call EmailOut
            End
        End If
    Next c
End If
End Sub

 

[Akashwani]

Peter,
This code sent out 3 emails!

Private Sub Workbook_SheetCalculate(ByVal Sh As Object)
Dim c As Range
If Sh.Name = "Sheet1" Then
    For Each c In Sh.Range("Y3:AE250")
        If c.Value = 20 Then
            Call EmailOut
            [COLOR=black]End[/COLOR]
        End If
    Next c
End If
End Sub

I only have one cell in the range that equals 20!

I believe this is responsible for the 1700+ emails, as I deleted the above, re introduced this into the sheet, then all email broke loose!

Private Sub Worksheet_Calculate()
Dim c As Range
For Each c In Range("Y3:AE250")
    If c.Value = 20 Then
        Call EmailOut
        Exit For
    End If
Next c
End Sub

Ak

 

[Akashwani]

I have just been experimenting,
when I change the data of a cell on my worksheet so the formula will create 20 somewhere in the range (Y3:AE250) then it sends 1 email using this code....

Private Sub Worksheet_Calculate()
Dim c As Range
For Each c In Range("Y3:AE250")
    If c.Value = 20 Then
        Call EmailOut
        End
    End If
Next c
End Sub

Yet when I use either of these codes when the workbook opens it sends out 3 emails.

Private Sub Worksheet_Calculate()
Dim c As Range
For Each c In Range("Y3:AE250")
    If c.Value = 20 Then
        Call EmailOut
        End
    End If
Next c
End Sub

Private Sub Workbook_SheetCalculate(ByVal Sh As Object)
Dim c As Range
If Sh.Name = "Sheet1" Then
    For Each c In Sh.Range("Y3:AE250")
        If c.Value = 20 Then
            Call EmailOut
            [COLOR=black]End[/COLOR]
        End If
    Next c
End If
End Sub

Strange eh?

Ak

 

[baitmaster]

I might suggest a beak point or similar to prevent the emails, until you've fully tried and tested the system

 

[VoG]

Try this: near the beginning of your EMailOut sub add

Application.EnableEvents = False

then before it completes, reset to True.

 

[Akashwani]

Good day Peter

Thanks for the addition,
using the following it now sends out 2 emails

Sub EmailOut()
'''This is to send an Email when a date is 20 days away'''
    Dim OutApp As Object
    Dim OutMail As Object
    Dim strto As String, strcc As String, strbcc As String
    Dim strsub As String, strbody As String
 Application.EnableEvents = False
    Set OutApp = CreateObject("Outlook.Application")
    OutApp.Session.Logon
    Set OutMail = OutApp.CreateItem(0)
 
    strto = [EMAIL="abc123@xyz.com"]abc123@xyz.com[/EMAIL]  ''Change Email address here
    strcc = ""
    strbcc = ""
    strsub = "Subject heading "
    strbody = "Good day" & vbNewLine & vbNewLine & _
              "Message here" & vbNewLine & vbNewLine & _
              "and here too"
    With OutMail
        .To = strto
        .CC = strcc
        .BCC = strbcc
        .Subject = strsub
        .Body = strbody
        .Send
    End With
 Application.EnableEvents = True
    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub

Thanks
Ak

 

[VoG]

You don't have both the Worksheet_Calculate and the Workbook_SheetCalculate codes present by any chance?