VBA question - email alerts prompted by cell values

[Toph42]

Hi,

I need to have email alerts prompted based on cell values (e.g. when call value is >200 an email alert is triggered). I've used the below VBA code, but it only works when I manually enter into the specific cells. I now need an email to be prompted when the values in the specified cells are populated by a formula. Does anyone know if I can amend this VBA code, or if there is another way to achieve this? Thank you!

<code style="margin: 0px; padding: 0px; font-style: inherit; font-weight: inherit; line-height: 12px;">Dim xRg As Range
'Update by Extendoffice 2018/3/7
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Target.Cells.Count > 1 Then Exit Sub
Set xRg = Intersect(Range("D7"), Target)
If xRg Is Nothing Then Exit Sub
If IsNumeric(Target.Value) And Target.Value > 200 Then
Call Mail_small_Text_Outlook
End If
End Sub
Sub Mail_small_Text_Outlook()
Dim xOutApp As Object
Dim xOutMail As Object
Dim xMailBody As String
Set xOutApp = CreateObject("Outlook.Application")
Set xOutMail = xOutApp.CreateItem(0)
xMailBody = "Hi there" & vbNewLine & vbNewLine & _
"This is line 1" & vbNewLine & _
"This is line 2"
On Error Resume Next
With xOutMail
.To = "Email Address"
.CC = ""
.BCC = ""
.Subject = "send by cell value test"
.Body = xMailBody
.Display 'or use .Send
End With
On Error GoTo 0
Set xOutMail = Nothing
Set xOutApp = Nothing
End Sub</code>

 

[DanteAmor]

Try this, change the change event for the Calculate event

When you modify any cell that affects the formula then the calculate event is activated.

Dim xRg As Range


Private Sub Worksheet_Calculate()
    On Error Resume Next
    Set xRg = Range("D7")
    If IsNumeric(xRg) And xRg.Value > 200 Then
        Call Mail_small_Text_Outlook
    End If
End Sub


Sub Mail_small_Text_Outlook()
    Dim xOutApp As Object
    Dim xOutMail As Object
    Dim xMailBody As String
    Set xOutApp = CreateObject("Outlook.Application")
    Set xOutMail = xOutApp.CreateItem(0)
    xMailBody = "Hi there" & vbNewLine & vbNewLine & _
        "This is line 1" & vbNewLine & _
        "This is line 2"
    On Error Resume Next
    With xOutMail
        .To = "Email Address"
        .CC = ""
        .BCC = ""
        .Subject = "send by cell value test"
        .body = xMailBody
        .display 'or use .Send
    End With
    On Error GoTo 0
    Set xOutMail = Nothing
    Set xOutApp = Nothing
End Sub

 

[Toph42]

Try this, change the change event for the Calculate event

When you modify any cell that affects the formula then the calculate event is activated.

Dim xRg As Range


Private Sub Worksheet_Calculate()
    On Error Resume Next
    Set xRg = Range("D7")
    If IsNumeric(xRg) And xRg.Value > 200 Then
        Call Mail_small_Text_Outlook
    End If
End Sub


Sub Mail_small_Text_Outlook()
    Dim xOutApp As Object
    Dim xOutMail As Object
    Dim xMailBody As String
    Set xOutApp = CreateObject("Outlook.Application")
    Set xOutMail = xOutApp.CreateItem(0)
    xMailBody = "Hi there" & vbNewLine & vbNewLine & _
        "This is line 1" & vbNewLine & _
        "This is line 2"
    On Error Resume Next
    With xOutMail
        .To = "Email Address"
        .CC = ""
        .BCC = ""
        .Subject = "send by cell value test"
        .body = xMailBody
        .display 'or use .Send
    End With
    On Error GoTo 0
    Set xOutMail = Nothing
    Set xOutApp = Nothing
End Sub

This is great, thank you!

 

[DanteAmor]

I'm glad to help you. Thanks for the feedback.

 

[Toph42]

I'm glad to help you. Thanks for the feedback.

Sorry, there is actually still one problem. It now prompts the email based on any value entered (not just values that are >200). I can't work out how to rectify this. Could you help? Thanks.

 

[DanteAmor]

Sorry, there is actually still one problem. It now prompts the email based on any value entered (not just values that are >200). I can't work out how to rectify this. Could you help? Thanks.

You can put the formula you have in cell D7.
And also tell me where are you entering values?
And what value do you have in D7?

 

[Toph42]

You can put the formula you have in cell D7.
And also tell me where are you entering values?
And what value do you have in D7?

I use the cell range F2:F24, with the formula in this range set at =(D3*1000)/E3

[TABLE="width: 713"]
[TR]
[TD]A[/TD]
[TD]B[/TD]
[TD]C[/TD]
[TD]D[/TD]
[TD]E[/TD]
[TD]F[/TD]
[/TR]
[TR]
[TD]DATE[/TD]
[TD]AM READING[/TD]
[TD]PM READING[/TD]
[TD]AM USAGE[/TD]
[TD]BIRDS[/TD]
[TD]L PER UNIT[/TD]
[/TR]
[TR]
[TD]Wednesday, 1 May 2019[/TD]
[TD]331784[/TD]
[TD]331921[/TD]
[TD]137[/TD]
[TD]13231[/TD]
[TD]10.35[/TD]
[/TR]
[/TABLE]

So every time a number in the range F2:F24 exceeds 10.5, I want the email prompt.

Now the email prompts whenever any number is changed in the range. It seems to ignore the >10.5 rule.

 

[DanteAmor]

Try this

Dim xRg As Range


Private Sub Worksheet_Calculate()
    'On Error Resume Next
    Dim c As Range
    Set xRg = Range("F2:F24")
    For Each c In xRg
        If Not IsError(c) Then
            If IsNumeric(c.Value) And c.Value > 10.5 Then
                Call Mail_small_Text_Outlook
            End If
        End If
    Next
End Sub


Sub Mail_small_Text_Outlook()
    Dim xOutApp As Object
    Dim xOutMail As Object
    Dim xMailBody As String
    Set xOutApp = CreateObject("Outlook.Application")
    Set xOutMail = xOutApp.CreateItem(0)
    xMailBody = "Hi there" & vbNewLine & vbNewLine & _
        "This is line 1" & vbNewLine & _
        "This is line 2"
    On Error Resume Next
    With xOutMail
        .To = "Email Address"
        .CC = ""
        .BCC = ""
        .Subject = "send by cell value test"
        .body = xMailBody
        .display 'or use .Send
    End With
    On Error GoTo 0
    Set xOutMail = Nothing
    Set xOutApp = Nothing
End Sub

 

[Toph42]

Still prompting email even though the values in cell range do not exceed 10.5.

 

[DanteAmor]

Still prompting email even though the values in cell range do not exceed 10.5.

No value in F2 to F24 is greater than 10.5?

It works for me, only if any of the values ​​in F2 to F24 is greater than 10.5 send the mail.
You can put an image of your data or upload an image or upload your file.

You could upload a copy of your file to a free site such www.dropbox.com. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here. If the workbook contains confidential information, you could replace it with generic data.



Did you modify something else in the macro?