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>

 

[Toph42]

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?

I think I have found the problem. When there is a cell value from a previous day that is >10.5, the new values entered always prompt the email based on any value.

For example, in the below table you can see that on Thursday the value is 10.74. After this all new values that are entered in this column prompt the email. If i start a new sheet without any previous numbers being >10.5 it is fine though. I have no idea how to get around this. Do you know?

DATE	AM READING	PM READING	AM USAGE	UNITS	L PER Unit
Wednesday, 1 May 2019	331784	331921	137	13231	10.35
Thursday, 2 May 2019	332139	332275	136	12668	10.74
Friday, 3 May 2019	332524	332680	156	17335	9.00
Monday, 6 May 2019	332970	333135	165	20640	7.99
Tuesday, 7 May 2019	333347	333509	162	17191	9.42

Thanks for your help. It is greatly appreciated.

 

[DanteAmor]

Let's go back to the formula.
I already understood that in F2 you do not capture data because there in F2 you have a formula.
Can you put again what formula you have in F2?

 

[Toph42]

In each of F2:F24, I have =(D6*1000)/E6.

If there is already one cell populated with a value >10.5, every subsequent number populated in that range prompts an email (even when the number is lower than 10.5).

What do you think?

A	B	C	D	E	F
DATE	AM READING	PM READING	AM USAGE	BIRDS	L PER BIRD
Wednesday, 1 May 2019	331784	331921	137	13231	10.35
Thursday, 2 May 2019	332139	332275	136	12668	10.74
Friday, 3 May 2019	332524	332680	156	17335	9.00
Monday, 6 May 2019	332970	333135	165	20640	7.99
Tuesday, 7 May 2019	333347	333509	162	17191	9.42
Thursday, 9 May 2019	333740	333861	121	16159	7.49

 

[DanteAmor]

What formula do you have in F2?
This
=(D6*1000)/E6.
Or this:
=(D3*1000)/E3
?

 

[Toph42]

What formula do you have in F2?
This
=(D6*1000)/E6.
Or this:
=(D3*1000)/E3
?

F2: =(D2*1000)/E2
F3: =(D3*1000)/E3
F4: =(D4*1000)/E4

and so on..

 

[DanteAmor]

Try this

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("D2:D24, E2:E24")) Is Nothing Then
        If Target.Count > 1 Then Exit Sub
        If Cells(Target.Row, "F").Value > 10.5 Then
            Call Mail_small_Text_Outlook
        End If
    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]

Now no email prompt at all

Maybe this could help - https://www.dropbox.com/s/mkkobhsffyuzrzz/Excel test.xlsm?dl=0

 

[DanteAmor]

You have to modify a cell in the range D2:D24 or E2:E24. For example, if you modify cell D6 and the result in F6 is greater than 10.5, then an email is generated.
But you have to change a data, either in D or in E.

 

[Toph42]

You have to modify a cell in the range D2:D24 or E2:E24. For example, if you modify cell D6 and the result in F6 is greater than 10.5, then an email is generated.
But you have to change a data, either in D or in E.

Thank you so much!!

 

[DanteAmor]

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