VBA send email based in cell value

[deanop2]

hi all,
struggling to find the answer to this issue
I have a code to send an email when cell A2 value is changed. it does work perfectly; however, I want it to work only when the number 3 is in the cell. the cell can have either 1,2 or 3 in the cell
any help is much appreciated, code below

Private Sub Worksheet_Change(ByVal Target As Range)
'Updated by Extendoffice 2017/9/12
Dim xRgSel As Range
Dim xOutApp As Object
Dim xMailItem As Object
Dim xMailBody As String
On Error Resume Next
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set xRg = Worksheets("Sheet1").Range("A2")
Set xRgSel = Intersect(Target, xRg)
ActiveWorkbook.Save
If Not xRgSel Is Nothing Then
Set xOutApp = CreateObject("Outlook.Application")
Set xMailItem = xOutApp.CreateItem(0)
xMailBody = "Cell(s) " & xRgSel.Address(False, False) & _
" in the worksheet '" & Me.Name & "' were modified on " & _
Format$(Now, "mm/dd/yyyy") & " at " & Format$(Now, "hh:mm:ss") & _
" by " & Environ$("username") & "."

With xMailItem
.To = "enter email address"
.Subject = "Worksheet modified in " & ThisWorkbook.FullName
.Body = xMailBody
.Attachments.Add (ThisWorkbook.FullName)
.Display
End With
Set xRgSel = Nothing
Set xOutApp = Nothing
Set xMailItem = Nothing
End If
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

 

[Joe4]

Try this:

Private Sub Worksheet_Change(ByVal Target As Range)
'Updated by Extendoffice 2017/9/12

    Dim xRgSel As Range
    Dim xOutApp As Object
    Dim xMailItem As Object
    Dim xMailBody As String

    On Error Resume Next

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    Set xRg = Worksheets("Sheet1").Range("A2")
    Set xRgSel = Intersect(Target, xRg)
    
    ActiveWorkbook.Save

    If (Not xRgSel Is Nothing) And (Target = 3) Then
        Set xOutApp = CreateObject("Outlook.Application")
        Set xMailItem = xOutApp.CreateItem(0)
        xMailBody = "Cell(s) " & xRgSel.Address(False, False) & _
            " in the worksheet '" & Me.Name & "' were modified on " & _
            Format$(Now, "mm/dd/yyyy") & " at " & Format$(Now, "hh:mm:ss") & _
            " by " & Environ$("username") & "."

        With xMailItem
            .To = "enter email address"
            .Subject = "Worksheet modified in " & ThisWorkbook.FullName
            .Body = xMailBody
            .Attachments.Add (ThisWorkbook.FullName)
            .Display
        End With

        Set xRgSel = Nothing
        Set xOutApp = Nothing
        Set xMailItem = Nothing
    
    End If
    
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True

End Sub

Also, in the future, please use code tags when posting VBA code, as described here: How to Post Your VBA Code
It maintains spacing (like my code above) and makes VBA code much easier to read, follow along, and edit, instead of having to copy/paste it to our side and fix it up (like I had to do).

 

[deanop2]

Perfect, thanks so much ??

 

[Joe4]

You are welcome.