Send Email If Certain Cells are Modified In Excel

S

Switched-On

New member
Joined
Jun 23, 2020
Messages
2
Reaction score
0
Points
0
Excel Version(s)
365
I have the below code which send an emails if the range M5:M9999 is changed. It works perfectly, but I also need an email sending to a different email address if L5:L9999 range is changed. I want a different message emailing to each address. Is someone able to help. Thank you


Private Sub Worksheet_Change(ByVal Target 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("M5:M9999")
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) & _
xRgSel.Value & _
" 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 = "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
 
The simplest thing to do might be to simply duplicate the section that sends the message and modify it.

Code: 
[COLOR=#3E3E3E]Private Sub Worksheet_Change(ByVal Target As Range)Dim xRgSel As Range[/COLOR]
[COLOR=#3E3E3E]Dim xOutApp As Object[/COLOR]
[COLOR=#3E3E3E]Dim xMailItem As Object[/COLOR]
[COLOR=#3E3E3E]Dim xMailBody As String[/COLOR]
[COLOR=#3E3E3E]On Error Resume Next[/COLOR]
[COLOR=#3E3E3E]Application.ScreenUpdating = False[/COLOR]
[COLOR=#3E3E3E]Application.DisplayAlerts = False[/COLOR]
[COLOR=#3E3E3E]Set xRg = Range("M5:M9999")[/COLOR]
[COLOR=#3E3E3E]Set xRgSel = Intersect(Target, xRg)[/COLOR]
[COLOR=#3E3E3E]ActiveWorkbook.Save[/COLOR]
[COLOR=#3E3E3E]If Not xRgSel Is Nothing Then[/COLOR]
[COLOR=#3E3E3E]Set xOutApp = CreateObject("Outlook.Application")[/COLOR]
[COLOR=#3E3E3E]Set xMailItem = xOutApp.CreateItem(0)[/COLOR]
[COLOR=#3E3E3E]xMailBody = "Cell(s) " & xRgSel.Address(False, False) & _[/COLOR]
[COLOR=#3E3E3E]xRgSel.Value & _[/COLOR]
[COLOR=#3E3E3E]" in the worksheet '" & Me.Name & "' were modified on " & _[/COLOR]
[COLOR=#3E3E3E]Format$(Now, "mm/dd/yyyy") & " at " & Format$(Now, "hh:mm:ss") & _[/COLOR]
[COLOR=#3E3E3E]" by " & Environ$("username") & "."[/COLOR]


[COLOR=#3E3E3E]With xMailItem[/COLOR]
[COLOR=#3E3E3E].To = "Email Address"[/COLOR]
[COLOR=#3E3E3E].Subject = "Worksheet modified in " & ThisWorkbook.FullName[/COLOR]
[COLOR=#3E3E3E].Body = xMailBody[/COLOR]
[COLOR=#3E3E3E].Attachments.Add (ThisWorkbook.FullName)[/COLOR]
[COLOR=#3E3E3E].Display[/COLOR]
[COLOR=#3E3E3E]End With[/COLOR]
[COLOR=#3E3E3E]Set xRgSel = Nothing[/COLOR]
[COLOR=#3E3E3E]Set xOutApp = Nothing[/COLOR]
[COLOR=#3E3E3E]Set xMailItem = Nothing[/COLOR]
[COLOR=#3E3E3E]End If[/COLOR]
[COLOR=#3E3E3E]' **************************************
[/COLOR][COLOR=#3E3E3E]Set xRg = Range("L5:L9999")[/COLOR]
[COLOR=#3E3E3E]Set xRgSel = Intersect(Target, xRg)[/COLOR]
[COLOR=#3E3E3E]ActiveWorkbook.Save[/COLOR]
[COLOR=#3E3E3E]If Not xRgSel Is Nothing Then[/COLOR]
[COLOR=#3E3E3E]Set xOutApp = CreateObject("Outlook.Application")[/COLOR]
[COLOR=#3E3E3E]Set xMailItem = xOutApp.CreateItem(0)[/COLOR]
[COLOR=#3E3E3E]xMailBody = "Cell(s) " & xRgSel.Address(False, False) & _[/COLOR]
[COLOR=#3E3E3E]xRgSel.Value & _[/COLOR]
[COLOR=#3E3E3E]" in the worksheet '" & Me.Name & "' were modified on " & _[/COLOR]
[COLOR=#3E3E3E]Format$(Now, "mm/dd/yyyy") & " at " & Format$(Now, "hh:mm:ss") & _[/COLOR]
[COLOR=#3E3E3E]" by " & Environ$("username") & "."[/COLOR]

[COLOR=#3E3E3E]With xMailItem[/COLOR]
[COLOR=#3E3E3E].To = "Email Address"[/COLOR]
[COLOR=#3E3E3E].Subject = "Worksheet modified in " & ThisWorkbook.FullName[/COLOR]
[COLOR=#3E3E3E].Body = xMailBody[/COLOR]
[COLOR=#3E3E3E].Attachments.Add (ThisWorkbook.FullName)[/COLOR]
[COLOR=#3E3E3E].Display[/COLOR]
[COLOR=#3E3E3E]End With[/COLOR]
[COLOR=#3E3E3E]Set xRgSel = Nothing[/COLOR]
[COLOR=#3E3E3E]Set xOutApp = Nothing[/COLOR]
[COLOR=#3E3E3E]Set xMailItem = Nothing[/COLOR]
[COLOR=#3E3E3E]End If[/COLOR]
[COLOR=#3E3E3E]'************************************
Application.DisplayAlerts = True[/COLOR]
[COLOR=#3E3E3E]Application.ScreenUpdating = True[/COLOR]
[COLOR=#3E3E3E]End Sub[/COLOR]
 
You must log in or register to reply here.
Back
Top