Im trying to add 2 different range and target value criteria. If the values are out or specified target value ranges, an email will be sent. Here is what I have so far:
Dim xRg As Range, rng 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("K3050:K4000"), Target)
If xRg Is Nothing Then Exit Sub
If IsNumeric(Target.Value) And Target.Value > 0.534 Or Target.Value < 0.519 Then
Call Mail_small_Text_Outlook
End If
Set rng = Intersect(Range("L3050:L4000"), Target)
If rng Is Nothing Then Exit Sub
If IsNumeric(Target.Value) And Target.Value > 0.003 Or Target.Value < 0.003 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 = "There is an out of spec value on 302-0092. Please confirm."
On Error Resume Next
With xOutMail
.To = "EMAIL HERE"
.CC = ""
.BCC = ""
.Subject = "Out of spec value on 302-0092"
.Body = xMailBody
.Send 'or use .Send
End With
On Error GoTo 0
Set xOutMail = Nothing
Set xOutApp = Nothing
End Sub
The first range of K3050:K4000 works and is able to generate an email, but I can't get the second range to work.
Transferring comments to an answer:
The problem is If xRg Is Nothing Then Exit Sub
, since you Exit Sub
before checking if Target
intersects the second range, L3050:L4000
.
Flip the logic; change:
If xRg Is Nothing Then Exit Sub
to
If Not xRg Is Nothing Then
...
End If
and similarly (though not needed) for rng
.