VBA Question - I want to Auto send an email when a cell value gets populated and it should select the values displayed on the left side of the cell

[SA754]

Hi VBA experts,

Need your help. I'm new to VBA world and learning.

Question " VBA Question - I want to Auto send an email when a cell value gets populated, and it should select the values displayed on the left side of the cell in the email body"

Dim xRg As Range

Dim xSA As Variant



'Test Macro to publish Auto email when there is a pending status



Private Sub Worksheet_Change(ByVal Target As Range)

On Error Resume Next

If Target.Cells.Count > 1 Then Exit Sub

Set xRg = Intersect(Range("E3:E1956"), Target)

If xRg Is Nothing Then Exit Sub

'If IsNumeric(Target.Value) And Target.Value > 0 Then

If Range("E3:E1956") = "Pending" Then

Call Mail_small_Text_Outlook

End If
'Extract the values from the Left column that is from ( "D3:D1956") when it meets xRg condition
xSA = Left(xRg, 12)

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" & vbNewLine & vbNewLine & _

"PLEASE CHECK"



On Error Resume Next

With xOutMail

'.SentOnBehalfofName = "1234"

.To = "ABC"

.CC = ""

.BCC = ""

.Subject = "PLEASE CHECK"

.Body = xMailBody

.Send

End With

On Error GoTo 0

Set xOutMail = Nothing

Set xOutApp = Nothing

End Sub

 

[rollis13]

You could use the macros with these few modifications:

Option Explicit
Dim xSA        As Variant
'Test Macro to publish Auto email when there is a pending status
Private Sub Worksheet_Change(ByVal Target As Range)
    On Error Resume Next
    If Target.Cells.CountLarge > 1 Then Exit Sub
    'check if we are in column E
    If Not Intersect(Range("E3:E1956"), Target) Is Nothing Then
        'check if target contains "Pending" else exit
        If Target = "Pending" Then
            'extract the value from the column D on the left of target
            xSA = Target.Offset(0, -1).Value
            Call Mail_Small_Text_Outlook
        Else
            Exit Sub
        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" & vbNewLine & xSA & vbNewLine & "PLEASE CHECK" '<- added information from column D
    On Error Resume Next
    With xOutMail
        '.SentOnBehalfofName = "1234"
        .To = "ABC@email.it"
        .CC = ""
        .BCC = ""
        .Subject = "PLEASE CHECK"
        .Body = xMailBody
        .Display                                  '<- use for testing
        '.Send
    End With
    On Error GoTo 0
    Set xOutMail = Nothing
    Set xOutApp = Nothing
End Sub

 

[SA754]

You could use the macros with these few modifications:

Option Explicit
Dim xSA        As Variant
'Test Macro to publish Auto email when there is a pending status
Private Sub Worksheet_Change(ByVal Target As Range)
    On Error Resume Next
    If Target.Cells.CountLarge > 1 Then Exit Sub
    'check if we are in column E
    If Not Intersect(Range("E3:E1956"), Target) Is Nothing Then
        'check if target contains "Pending" else exit
        If Target = "Pending" Then
            'extract the value from the column D on the left of target
            xSA = Target.Offset(0, -1).Value
            Call Mail_Small_Text_Outlook
        Else
            Exit Sub
        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" & vbNewLine & xSA & vbNewLine & "PLEASE CHECK" '<- added information from column D
    On Error Resume Next
    With xOutMail
        '.SentOnBehalfofName = "1234"
        .To = "ABC@email.it"
        .CC = ""
        .BCC = ""
        .Subject = "PLEASE CHECK"
        .Body = xMailBody
        .Display                                  '<- use for testing
        '.Send
    End With
    On Error GoTo 0
    Set xOutMail = Nothing
    Set xOutApp = Nothing
End Sub

Thank you so much! I've plugged in and it's working

 

[rollis13]

Glad having been of some help, now you can work on it and personalize it if something is still missing.