Sending Emails to Muliple People

[longlern]

Hello All,

I'm working on editing this VBA code below to allow edits in additional cells to trigger an email sent to additional email address. Could anyone help me edit this code to allow for 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 = Range("I4:I4")
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 = "lauren.skenes@us.abb.com"
.Subject = "Worksheet modified in " & ThisWorkbook.FullName
.Body = "Hi," & vbCrLf & vbCrLf & "The worksheet " & Chr(34) & ActiveWorkbook.Sheets(1).Name & Chr(34) & " has a task update for you. Please update the Status column as you proceed."
.Attachments.Add (ThisWorkbook.FullName)
.Send
End With
Set xRgSel = Nothing
Set xOutApp = Nothing
Set xMailItem = Nothing
End If
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

Thank you!

 

[Logit]

.
This slightly edited macro functions if pasted into the Sheet 1 module and a change of data is made in cell I4.

What additional changes were you wanting to make ?

Option Explicit


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


Dim xRg As Range
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 = Range("I4:I4")
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 = "me@my.com"
                .Subject = "Worksheet modified in " & ThisWorkbook.FullName
                .Body = "Hi," & vbCrLf & vbCrLf & "The worksheet " & Chr(34) & ActiveWorkbook.Sheets(1).Name & Chr(34) & " has a task update for you. Please update the Status column as you proceed."
                .Attachments.Add (ThisWorkbook.FullName)
                '.Send
                .Display
                
            End With
            
        Set xRgSel = Nothing
        Set xOutApp = Nothing
        Set xMailItem = Nothing
        
    End If
    
Application.DisplayAlerts = True
Application.ScreenUpdating = True


End Sub