VBA question - email alerts prompted by cell values

Toph42

New Member
Joined
May 19, 2019
Messages
10
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!
File-Copy-icon.png

<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>
 

Excel Facts

Copy a format multiple times
Select a formatted range. Double-click the Format Painter (left side of Home tab). You can paste formatting multiple times. Esc to stop
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.

Code:
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
 
Upvote 0
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.

Code:
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!
 
Upvote 0
I'm glad to help you. Thanks for the feedback.
 
Upvote 0
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.
 
Upvote 0
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?
 
Upvote 0
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

ABCDEF
DATEAM READINGPM READINGAM USAGEBIRDSL PER UNIT
Wednesday, 1 May 20193317843319211371323110.35

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.
 
Upvote 0
Try this

Code:
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
 
Upvote 0
Still prompting email even though the values in cell range do not exceed 10.5. :confused:

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?
 
Upvote 0

Forum statistics

Threads
1,213,543
Messages
6,114,238
Members
448,555
Latest member
RobertJones1986

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top