VBA Code to insert cell value in the body of an email

[IneedHel]

I currently have code that will send an email automatically once a value is changed in a cert cell see below. I want to include the value from another cell in the body of the email how do I do this? example of what I need.

Headers = Date (A2) Run# (B2) Status (C3)
2/2/17 12 resolved

Currently when the email is sent the body says "Status has been updated"

I want the code to add the run # from the B2 column

so it looks like this "Status has been updated"
Run # 12



Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect([c3:c5555], Target) Is Nothing Then
Set olApp = CreateObject("Outlook.application")
Set M = olApp.CreateItem(olMailItem)
With M
.Subject = "Billing QA"
.Body = "Status has been updated"
.Recipients.Add "cporter@medicambulance.net"
.Attachments.Add ActiveWorkbook.FullName
.send
End With
End If
End Sub

 

[MrKowz]

Welcome to the forums!

This is untested, but try the below. Note, I commented out the .Send and added .Display, so you can ensure it works as intended before having it actually send emails. Also, because the board's code parses HTML, where you see the highlighted < br>, remove that extra space.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim strbody     As String
If Not Intersect([c3:c5555], Target) Is Nothing Then
    Set olApp = CreateObject("Outlook.application")
    Set M = olApp.CreateItem(olMailItem)
    strbody = "Status has been updated[B][COLOR="#FF0000"] < br>[/COLOR][/B] Run # " & Target.Offset(0, -1).Value
    With M
        .Subject = "Billing QA"
        .HTMLBody = strbody
        .Recipients.Add "cporter@medicambulance.net"
        .Attachments.Add ActiveWorkbook.FullName
        '.Send
        .Display
    End With
End If
End Sub

 

[IneedHel]

It works! the issue now is that it sends the email prior to me saving the doc its sends as soon as I change the status in column c also it sends multiple emails if I change more than one item in the sheet. how can i have the email send only after I save it and include all the run # associated to the changes?

 

[MrKowz]

Now we're talking about a horse of a different color.

To accomplish this, you'll need a few extra components. First off, it's sounding like you'll be making several changes to this sheet, and you want to send a singular summary email immediately after you save the workbook. For this, we will need to adjust the worksheet_change event to instead build a log of changes. Secondly, we can use the workbook level event Workbook_AfterSave to have the email code fire after saving the workbook.

Lets try this. Create a new worksheet called "temp" and make it hidden. We will use this worksheet to store the changes. Now, lets change your worksheet_change macro to:

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Range("C:C"), Target) Is Nothing Then
    Sheets("temp").Range("A1").Value = Sheets("temp").Range("A1").Value & Target.Offset(0, -1).Value & ", "
End If
End Sub

This code will build a list of all changes as you make them in A1 in the "temp" worksheet.

Now, go to the "ThisWorkbook" module and enter the following code:

Private Sub Workbook_AfterSave(ByVal Success As Boolean)
If Success = True Then
    If Sheets("temp").Range("A1").Value <> "" Then
        Dim strbody     As String
        Set olApp = CreateObject("Outlook.application")
        Set M = olApp.CreateItem(olMailItem)
        strbody = "Status has been updated on the following Run #'s < br> " & Left$(Sheets("temp").Range("A1").Value, Len(Sheets("temp").Range("A1").Value) - 2)
        With M
            .Subject = "Billing QA"
            .HTMLBody = strbody
            .Recipients.Add "cporter@medicambulance.net"
            .Attachments.Add ActiveWorkbook.FullName
            '.Send
            .Display
        End With
    End If
End If

End Sub

Private Sub Workbook_Open()
Sheets("temp").Range("A1").Value = ""
End Sub

This will clear the log from A1 in the temp worksheet when you open the file, and will create the email after you successfully save the file, inserting the list of Run #'s that were logged.

 

[IneedHel]

Your amazing! The code has worked perfect, The executives have decide to go with the first code you wrote they want the individual email for every change instead of the grouping of run #'s. The last thing I wanted to do was add the status that was changed in the body of the email. The status is from a pick list and contains Open,Pending & Resolved and is located in column C starting in C3 down.

currently the body of the email looks like this

Status has been updated
Run # 7

I want to add what the status change was :example


Example:
Status has been changed to Open
Run # 7

Much appreciated for the assistance

 

[MrKowz]

Happy the code is functioning for you! Here's the code with the requested changes. Again, be sure to remove that extra space in < br>

Private Sub Worksheet_Change(ByVal Target As Range)
Dim strbody     As String
If Not Intersect(Range("C:C"), Target) Is Nothing Then
    Set olApp = CreateObject("Outlook.application")
    Set M = olApp.CreateItem(olMailItem)
    strbody = "Status has been changed to " & Target.Value & "[B][COLOR="#FF0000"]< br> [/COLOR][/B]Run # " & Target.Offset(0, -1).Value
    With M
        .Subject = "Billing QA"
        .HTMLBody = strbody
        .Recipients.Add "cporter@medicambulance.net"
        .Attachments.Add ActiveWorkbook.FullName
        '.Send
        .Display
    End With
End If
End Sub

 

[IneedHel]

Works perfect thank you very much!

 

[MrKowz]

Works perfect thank you very much!

Cheers - thanks for the feedback. Have a great day/weekend!

 

[Victoria M]

Hi I am hoping someone can help me out. I have a spreadsheet that has training information on it. I have already created a command button that will automatically open outlook and generate an email that I can then send. However what I need it to do is input the contents of column B (which has the email addresses) once filtered to show who needs the email reminder, into the code so those email addresses automatically are loaded in the To: box. This is the code I have and the .to =“Email Address“ is where it tells me to put the email address. But I want it to pull directly from the cells that are either highlighted or filtered. I am completely clueless so please be easy, I copied this code from another site and it works perfectly for what I need minus that little fact.

Private Sub CommandButton1_Click()
'Updated by Extendoffice 2017/9/14
Dim xOutApp As Object
Dim xOutMail As Object
Dim xMailBody As String
On Error Resume Next
Set xOutApp = CreateObject("Outlook.Application")
Set xOutMail = xOutApp.CreateItem(0)
xMailBody = "Body content" & vbNewLine & vbNewLine & _
"This is line 1" & vbNewLine & _
"This is line 2"
On Error Resume Next
With xOutMail
.To = "Email Address"
.CC = ""
.BCC = ""
.Subject = "Test email send by button clicking"
.Body = xMailBody
.Display 'or use .Send
End With
On Error GoTo 0
Set xOutMail = Nothing
Set xOutApp = Nothing
End Sub