VBA - Send email based on a cells value; Include other cells value's from the same line in email subject

[Jibsta]

Hi All - I currently have a VBA script written to trigger an email being drafted based on if a cells value in column K = 'Needs Approval'. I am struggling trying to include other details from the excel sheet in the body of my email though. I do not want to point at a specific cell, rather point at the value of the column that is on the same line where the user chose 'Needs Approval' in column K.

Lets say on line 12, a user selected 'Needs Approval' in column K. I need to grab additional identifiable data from line 12 in columns A, B, F, etc. such as their name, date, location and then include that in my email body.

Attached below is the code that I have so far. I need help plugging in column info in the email body. Any help is greatly appreciated!!

Dim xRg As Range
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Target.Cells.Count > 1 Then Exit Sub
Set xRg = Intersect(Range("K:K"), Target)
If xRg Is Nothing Then Exit Sub
If Target.Value = "Needs Approval" 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 = "Good Afternoon,<br><br>" _
& "Please approve the below travel estimate that has been loaded on the Nakupuna Travel Tracker:<br><br>" _
& "<b>Name: </b><br>" _
& "<b>TO: </b><br>" _
& "<b>Dates: </b><br>" _
& "<b>Location: </b><br>" _
& "<b>Reason: </b><br>" _
& "<b>Secuirty Access Required: </b><br>" _
& "<b>Cost: </b><br><br>"
On Error Resume Next
With xOutMail
.To = ""
.CC = ""
.BCC = ""
.Subject = "Travel Estimate for "
.HTMLBody = xMailBody
.Display 'or use .Send
End With
On Error GoTo 0
Set xOutMail = Nothing
Set xOutApp = Nothing
End Sub

 

[Z51]

You can reference Target.Offset(rows, columns). For example, if you want to grab the Name in column A from the Target row (based on the value found in column K), you could use:

"Name: " & Target.Offset(0, -10).Value & ...

-10, because column A is 10 columns to the left of column K. If you needed column P, change -10 to 5, since P is five columns to the right of K.

 

[Jibsta]

You can reference Target.Offset(rows, columns). For example, if you want to grab the Name in column A from the Target row (based on the value found in column K), you could use:

"Name: " & Target.Offset(0, -10).Value & ...

-10, because column A is 10 columns to the left of column K. If you needed column P, change -10 to 5, since P is five columns to the right of K.

Whenever I add the Target.Offset reference after the "Name: " in the email body, the macro no longer initiates when I select 'Needs Approval' in column K. To do another test, I put .Subject = Target.Offset(0, -10).Value in the subject line of the email. The macro runs but the subject line does not populate and is blank. Any idea why either scenario is not working?

 

[Z51]

Try passing the Target as a range to the e-mail macro. See adjusted code below. I also removed your On Error statements as they shouldn't be necessary, and should be handled rather than ignored.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim xRg As Range

If Target.Cells.Count > 1 Then Exit Sub
If Not Intersect(Target, Range("K:K")) Is Nothing Then
    If Target.Value = "Needs Approval" Then Call Mail_small_Text_Outlook(Target)
End If
End Sub

Sub Mail_small_Text_Outlook(r As Range)
Dim xOutApp As Object, xOutMail As Object, xMailBody As String
Set xOutApp = CreateObject("Outlook.Application")
Set xOutMail = xOutApp.CreateItem(0)

xMailBody = "Good Afternoon,<br><br>" & _
    "Please approve the below travel estimate that has been loaded on the Nakupuna Travel Tracker:<br><br>" & _
    "<b>Name: " & r.Offset(0, -10).Value & "</b><br>" & _
    "<b>TO: " & r.Offset(0, 5).Value & "</b><br>" & _
    "<b>Dates: </b><br>" & _
    "<b>Location: </b><br>" & _
    "<b>Reason: </b><br>" & _
    "<b>Secuirty Access Required: </b><br>" & _
    "<b>Cost: </b><br><br>"

With xOutMail
    .To = ""
    .CC = ""
    .BCC = ""
    .Subject = "Travel Estimate for "
    .HTMLBody = xMailBody
    .Display 'or use .Send
End With

Set xOutMail = Nothing
Set xOutApp = Nothing
End Sub

 

[Jibsta]

Try passing the Target as a range to the e-mail macro. See adjusted code below. I also removed your On Error statements as they shouldn't be necessary, and should be handled rather than ignored.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim xRg As Range

If Target.Cells.Count > 1 Then Exit Sub
If Not Intersect(Target, Range("K:K")) Is Nothing Then
    If Target.Value = "Needs Approval" Then Call Mail_small_Text_Outlook(Target)
End If
End Sub

Sub Mail_small_Text_Outlook(r As Range)
Dim xOutApp As Object, xOutMail As Object, xMailBody As String
Set xOutApp = CreateObject("Outlook.Application")
Set xOutMail = xOutApp.CreateItem(0)

xMailBody = "Good Afternoon,<br><br>" & _
    "Please approve the below travel estimate that has been loaded on the Nakupuna Travel Tracker:<br><br>" & _
    "<b>Name: " & r.Offset(0, -10).Value & "</b><br>" & _
    "<b>TO: " & r.Offset(0, 5).Value & "</b><br>" & _
    "<b>Dates: </b><br>" & _
    "<b>Location: </b><br>" & _
    "<b>Reason: </b><br>" & _
    "<b>Secuirty Access Required: </b><br>" & _
    "<b>Cost: </b><br><br>"

With xOutMail
    .To = ""
    .CC = ""
    .BCC = ""
    .Subject = "Travel Estimate for "
    .HTMLBody = xMailBody
    .Display 'or use .Send
End With

Set xOutMail = Nothing
Set xOutApp = Nothing
End Sub

This worked flawlessly! Thank you very much for all of your help!