Skip to main content

How to send email if a certain cell is modified in Excel?

This article is talking about sending an email through Outlook when a cell in a certain range is modified in Excel.

Send email if cell in a certain range is modified with VBA code

Send email if cell in a certain range is modified with VBA code

If you need to create a new email automatically with active workbook attached when a cell in range A2:E11 is modified in a certain worksheet, the following VBA code can help you.

1. In the worksheet which you need to send email based on its modified cell in a certain range, right-click the sheet tab and then click the View Code from the context menu. See screenshot:

2. In the popping up Microsoft Visual Basic for Applications window, please copy and paste below VBA code into the Code window.

VBA code: Send email if cell in a specified range is modified in Excel

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("A2:E11")
    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 = "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

Notes:

1). In the code, A2:E11 is the range you will send email based on.
2). Please change the email body as you need in xMailBody line in the code.
3). Replace the Email Address with the recipient email address in line .To = "Email Address".
4). Change the email subject in line .Subject = "Worksheet modified in " & ThisWorkbook.FullName.

3. Press the Alt + Q keys simultaneously to close the Microsoft Visual Basic for Applications window.

From now on, any cell in range A2:E11 is modified, a new email will be created with the updated workbook attached. And all specified fields such as subject, recipient and email body will be listed in the email. Please send the email.

Note: The VBA code works only if you are using Outlook as your email program.

Related articles:

Best Office Productivity Tools

Popular Features: Find, Highlight or Identify Duplicates   |  Delete Blank Rows   |  Combine Columns or Cells without Losing Data   |   Round without Formula ...
Super Lookup: Multiple Criteria VLookup  |   Multiple Value VLookup  |   VLookup Across Multiple Sheets   |   Fuzzy Lookup ....
Advanced Drop-down List: Quickly Create Drop Down List   |  Dependent Drop Down List   |  Multi-select Drop Down List ....
Column Manager: Add a Specific Number of Columns  |  Move Columns  |  Toggle Visibility Status of Hidden Columns  |  Compare Ranges & Columns ...
Featured Features: Grid Focus   |  Design View   |   Big Formula Bar   |  Workbook & Sheet Manager   |  Resource Library (Auto Text)   |  Date Picker   |  Combine Worksheets   |  Encrypt/Decrypt Cells   |  Send Emails by List   |  Super Filter   |   Special Filter (filter bold/italic/strikethrough...) ...
Top 15 Toolsets:  12 Text Tools (Add Text, Remove Characters, ...)   |   50+ Chart Types (Gantt Chart, ...)   |   40+ Practical Formulas (Calculate age based on birthday, ...)   |   19 Insertion Tools (Insert QR Code, Insert Picture from Path, ...)   |   12 Conversion Tools (Numbers to Words, Currency Conversion, ...)   |   7 Merge & Split Tools (Advanced Combine Rows, Split Cells, ...)   |   ... and more

Supercharge Your Excel Skills with Kutools for Excel, and Experience Efficiency Like Never Before. Kutools for Excel Offers Over 300 Advanced Features to Boost Productivity and Save Time.  Click Here to Get The Feature You Need The Most...

kte tab 201905

Office Tab Brings Tabbed interface to Office, and Make Your Work Much Easier

  • Enable tabbed editing and reading in Word, Excel, PowerPoint, Publisher, Access, Visio and Project.
  • Open and create multiple documents in new tabs of the same window, rather than in new windows.
  • Increases your productivity by 50%, and reduces hundreds of mouse clicks for you every day!
Comments (41)
Rated 5 out of 5 · 1 ratings
Ajay_2510
Ajay_2510
This comment was minimized by the moderator on the site
Hi, Please I want the above code with two little changes

1.It should work at workbook level if there is any change in entire workbook or cell it should send mail
2.Code should trigger mail after cell change but on workbook save
Reply
Report
0
0
Ajay_2510
Ajay_2510
This comment was minimized by the moderator on the site
Hi, Please I want the above code with two little changes

1.It should work at workbook level if there is any change in entire workbook or cell it should send mail
2.Code should trigger mail not on cell change but on workbook save
Reply
Report
0
0
crystal
crystal     Ajay_2510
This comment was minimized by the moderator on the site
Hi Ajay_2510,
To achieve your two requirements:

1. Have the event trigger for changes on any worksheet within the workbook.
2. Trigger the event only when saving the workbook.

You'll need to move your code from the Worksheet_Change event in a specific worksheet to the Workbook_BeforeSave event in the ThisWorkbook module.
https://www.extendoffice.com/images/stories/comments/comment-picture-zxm/thisworkbook.png?1692238842

Here's the modified code:


Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Dim xOutApp As Object
    Dim xMailItem As Object
    Dim xMailBody As String
    On Error Resume Next
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    Set xOutApp = CreateObject("Outlook.Application")
    Set xMailItem = xOutApp.CreateItem(0)
    xMailBody = "The workbook '" & ThisWorkbook.FullName & _
                "' was modified on " & Format$(Now, "mm/dd/yyyy") & _
                " at " & Format$(Now, "hh:mm:ss") & " by " & Environ$("username") & "."

    With xMailItem
        .To = "Email Address"
        .Subject = "Workbook modified: " & ThisWorkbook.FullName
        .Body = xMailBody
        .Attachments.Add (ThisWorkbook.FullName)
        .Display   ' Or use .Send to send the email automatically
    End With

    Set xOutApp = Nothing
    Set xMailItem = Nothing

    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub
Reply
Report
1
0
Ajay_2510
Ajay_2510     crystal
This comment was minimized by the moderator on the site
Only 1 issue here ,Otherwise it works great.

1.It triggers mail also if someone opens workbook and saves it (Without making changes)

I want it to trigger mail if changes are made in workbook and saved only in that particular case.
if user is not making changes and just opening and saving the workbook the mail should not shoot.

Thanks for the help, I appreciate it
Reply
Report
0
0
Rated 5 out of 5
Joe
Joe
This comment was minimized by the moderator on the site
Here's another question. If one cell changes, it sends a email. if 3 cells change, it sends 3 emails. How do you stop this so it only sends 1 email when the edits are done?
Reply
0
0
crystal
crystal     Joe
This comment was minimized by the moderator on the site
Hi Joe,
Supposing you specified the range as "A2:E11" in the code. How can I verify when the whole edits are done?
Reply
Report
0
0
Joe
Joe
This comment was minimized by the moderator on the site
I would like to send the email to 5 people. What delineator is used between each email address?
Reply
0
0
crystal
crystal     Joe
This comment was minimized by the moderator on the site
Hi Joe,
Please use a semicolon to separate the email addresses.
Reply
Report
0
0
ychevray
ychevray
This comment was minimized by the moderator on the site
Bonjour et merci pour ce tuto.
J'ai cependant une difficulté pour l'application de la plage de recherche.
Dans le code, j'ai demandé à vérifier la plage C2:C4.
Tout fonctionne bien si je modifie C2, C3 ou C4 uniquement. Cela fonctionne aussi si je modifie C2+C3+C4 ou C2+C3 ou C3+C4 mais cela ne fonctionne pas si j'ai un saut dans la plage. Par exemple, si je modifie C2 et C4 sans modifier C3.
Est-ce que quelqu'un pourrait m'aider pour m'indiquer où se trouve mon erreur ?
Merci d'avance.

Private Sub Worksheet_Change(ByVal Target As Range)
'Updated by Extendoffice 20220921
Dim xAddress As String
Dim xDRg, xRgSel, xRg As Range

xAddress = "C2:C4"
Set xDRg = Range(xAddress)
Set xRgSel = Intersect(Target, xDRg)
On Error GoTo Err1
If Not xRgSel Is Nothing Then
If ThisWorkbook.gChangeRange = "" Then
ThisWorkbook.gChangeRange = xRgSel.AddressLocal(False, False, xlA1, True, False)
Else
Set xRg = Range(ThisWorkbook.gChangeRange)
Set xRg = Application.Union(xRg, xRgSel)
ThisWorkbook.gChangeRange = xRg.AddressLocal(False, False, xlA1, True, False)
End If
End If
Exit Sub
Err1:
ThisWorkbook.gChangeRange = xRgSel.AddressLocal(False, False, xlA1, True, False)
End Sub


-----

Option Explicit
Public gChangeRange As String
Private Sub Workbook_AfterSave(ByVal Success As Boolean)
'Updated by Extendoffice 20220921
Dim xRgSel, xRg As Range
Dim xOutApp As Object
Dim xMailItem As Object
Dim xMailBody As String
'On Error Resume Next
On Error GoTo Err1
Set xRg = Range(gChangeRange)
If Not xRg Is Nothing Then
Set xOutApp = CreateObject("Outlook.Application")
Set xMailItem = xOutApp.CreateItem(0)
xMailBody = "Cher Jean-Marie, " & vbCrLf & vbCrLf & "Dans le fichier : " & ThisWorkbook.FullName & vbCrLf & "La plage de cellules a été modifiée :" & xRg.Address(False, False) & vbCrLf & vbCrLf & "Cordialement"
With xMailItem
.To = ""
.Subject = "Données modifiées " & ThisWorkbook.Name
.Body = xMailBody
.Attachments.Add (ThisWorkbook.FullName)
.Display
End With
Set xRgSel = Nothing
Set xOutApp = Nothing
Set xMailItem = Nothing
End If
Err1:
gChangeRange = ""
End Sub
Reply
0
0
Kathryn F
Kathryn F
This comment was minimized by the moderator on the site
I'm needing some help with triggering an email with a slight change. Instead of a numerical value or entering the information into the cell manually, cells in column B will change to 'Y' triggered from a formula in other cells in that row. The formula for column B is =IF([@[Quantity in Stock]]>[@[Reorder Level]],,"Y"), showing that the inventory is low in stock and needs a re-order. I need to trigger an automated email when a cell value changes in column B to 'Y', so I'm notified automatically via email of the low stock. I've tried everything I can think of in altering codes already provided, but nothing seems to work for me... please help!
Reply
0
0
crystal
crystal     Kathryn F
This comment was minimized by the moderator on the site
Hi Kathryn F,
The following VBA code can help you solve the problem. Please give it a try. Thank you for your comment.
Dim xRg As Range
'Update by Extendoffice 20221019
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Target.Cells.Count > 1 Then Exit Sub
Set xRg = Intersect(Range("B:B"), Target)
If xRg Is Nothing Then Exit Sub
If Target.Value = "Y" 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 = "Hi there" & vbNewLine & vbNewLine & _
"This is line 1" & vbNewLine & _
"This is line 2"
On Error Resume Next
With xOutMail
.To = "Email Address"
.CC = ""
.BCC = ""
.Subject = "send by cell value test"
.Body = xMailBody
.Display 'or use .Send
End With
On Error GoTo 0
Set xOutMail = Nothing
Set xOutApp = Nothing
End Sub

Private Sub Worksheet_Calculate()
Dim xTarget As String
Dim xRg As Range
'Set xRg = Application.Range("B:B")
Set xRg = Intersect(Range("B:B"), Selection.EntireRow)
On Error GoTo Err01
If xRg.Value = "Y" Then
Call Mail_small_Text_Outlook
End If
Err01:
End Sub
Reply
Report
0
0
Esser123
Esser123
This comment was minimized by the moderator on the site
Hallo zusammen,

der Code würde gut für mein Vorhaben passen, aber gibt es die Möglichkeit, dass er eine E-Mail beim speichern schreibt mit allen Zellen die geändert wurden? So wie es jetzt ist ,würde er jede geänderte Zelle einzeln senden. Dies ist dann problematisch wenn z.B. 10 Zellen angepasst werden was 10 E-Mails bedeuten würde. Und gibt es die Möglichkeit, die gesamte geänderte Zelle bei mir von A bis Y in einer E-Mail zu senden? Bisher haut der ja die Zellnummer in die E-Mail, wenn aber jemand anders Filtert wird er die Änderung nicht mehr finden.
Reply
0
0
crystal
crystal     Esser123
This comment was minimized by the moderator on the site
Hi Esser123,
The following VBA codes can help. After modifying the cells in the specified range and save the workbook, an email will pop up to list all modified cells in the email body, and the workbook will be inserted as an attachment in the email as well. Please follow the following steps:
1. Open the worksheet that contains the cells you want to send emails based on, right click the sheet tab and click View Code from the right-click menu. Then copy the following code into the sheet(code) window.
Private Sub Worksheet_Change(ByVal Target As Range)
'Updated by Extendoffice 20220921
Dim xAddress As String
Dim xDRg, xRgSel, xRg As Range

xAddress = "A1:A8"
Set xDRg = Range(xAddress)
Set xRgSel = Intersect(Target, xDRg)
On Error GoTo Err1
If Not xRgSel Is Nothing Then
If ThisWorkbook.gChangeRange = "" Then
ThisWorkbook.gChangeRange = xRgSel.AddressLocal(False, False, xlA1, True, False)
Else
Set xRg = Range(ThisWorkbook.gChangeRange)
Set xRg = Application.Union(xRg, xRgSel)
ThisWorkbook.gChangeRange = xRg.AddressLocal(False, False, xlA1, True, False)
End If
End If
Exit Sub
Err1:
      ThisWorkbook.gChangeRange = xRgSel.AddressLocal(False, False, xlA1, True, False)
End Sub

2. In the Visual Basic editor, double click ThisWorkbook in the left pane, then copy the following VBA code to the ThisWorkbook(Code) window.
Option Explicit
Public gChangeRange As String
Private Sub Workbook_AfterSave(ByVal Success As Boolean)
'Updated by Extendoffice 20220921
Dim xRgSel, xRg As Range
Dim xOutApp As Object
Dim xMailItem As Object
Dim xMailBody As String
'On Error Resume Next
On Error GoTo Err1
Set xRg = Range(gChangeRange)
If Not xRg Is Nothing Then
   Set xOutApp = CreateObject("Outlook.Application")
        Set xMailItem = xOutApp.CreateItem(0)
        xMailBody = "Email Body: " & vbCrLf & "The following cells were modified:" & xRg.Address(False, False)
        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
Err1:
gChangeRange = ""
End Sub
Reply
Report
0
0
Daria Altstadt
Daria Altstadt
This comment was minimized by the moderator on the site
Hello, I have created a similar code but I would like to *** a condition where if a cell value is deleted that is will not send an email when it is save/closed. It will only send an email when a cell value has been entered. Do you know how to do this? This is my code:

CODE FOR AUTOMATIC EMAIL TO SOMEONE WHEN EXCEL WORKBOOK IS UPDATED

SHEET CODE:

Option Explicit 'Excel worksheet change event Range
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("C3:D62")) Is Nothing Then
'Target.EntireRow.Interior.ColorIndex = 15
Range("XFD1048576").Value = 15
End If
If Not Intersect(Target, Range("I3:J21")) Is Nothing Then
'Target.EntireRow.Interior.ColorIndex = 15
Range("XFD1048576").Value = 15
End If
End Sub


WORKBOOK CODE:

Private Sub Workbook_BeforeClose(Cancel As Boolean)
If Me.Saved = False Then Me.Save

Dim xOutApp As Object
Dim xMailItem As Object
Dim xName As String

If Range("XFD1048576").Value = 15 Then
On Error Resume Next
Set xOutApp = CreateObject("Outlook.Application")
Set xMailItem = xOutApp.CreateItem(0)
xName = ActiveWorkbook.FullName
With xMailItem
.To = "email"
.CC = ""
.Subject = "message"
.Body = "message!"
.Attachments.*** xName
.Display
'.send
End With
End If
Set xMailItem = Nothing
Set xOutApp = Nothing



End Sub

Private Sub Workbook_Open()
Range("XFD1048576").Clear
End Sub
Reply
0
0
hakana
hakana
This comment was minimized by the moderator on the site
Thank you for the code, this code works when I enter the value and press enter. But in my case the cell is filling automatically with formula, and when the value is reached it doesn't open the email so the code do not works in this case. Thank you in advance!
Reply
Report
0
0
crystal
crystal     hakana
This comment was minimized by the moderator on the site
Hi hakana,
The following VBA code can help you solve the problem. Please give it a try. Thank you for your feedback.

<div data-tag="code">Private Sub Worksheet_Change(ByVal Target As Range)
'Updated by Extendoffice 2022/04/15
Dim xRgSel As Range
Dim xOutApp As Object
Dim xMailItem As Object
Dim xMailBody As String
Dim xBoolean As Boolean
Dim xItsRG As Range
Dim xDDs As Range
Dim xDs As Range
On Error Resume Next
Application.ScreenUpdating = False
Application.DisplayAlerts = False
xBoolean = False
Set xRg = Range("E2:E13")

Set xItsRG = Intersect(Target, xRg)
Set xDDs = Intersect(Target.DirectDependents, xRg)
Set xDs = Intersect(Target.Dependents, xRg)
If Not (xItsRG Is Nothing) Then
Set xRgSel = xItsRG
xBoolean = True
ElseIf Not (xDDs Is Nothing) Then
Set xRgSel = xDDs
xBoolean = True
ElseIf Not (xDs Is Nothing) Then
Set xRgSel = xDs
xBoolean = True
End If


ActiveWorkbook.Save
If xBoolean Then
Debug.Print xRgSel.Address


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 = "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
Reply
Report
0
0
Kmac
Kmac
This comment was minimized by the moderator on the site
Is it possible to change this so it only displays the email if a cell in a range has been changed to say "Yes". Would like it to do nothing if it is any other value.
Reply
Report
0
0
There are no comments posted here yet
Load More
Please leave your comments in English
Guest
Posting as Guest
×
Rate this post:
Reset
0   Characters
Suggested Locations