How to automatically send email based on cell value in Excel?

Supposing you want to send an email through Outlook to a certain recipient based on a specified cell value in Excel. For example, when the value of cell D7 in a worksheet is greater than 200, then an email is created automatically. This article introduces a VBA method for you to quickly solve this issue.

Automatically send email based on cell value with VBA code

Automatically send email based on cell value with VBA code

Please do as follows to send an email based on cell value in Excel.

1. In the worksheet you need to send email based on its cell value (here says the cell D7), right-click the sheet tab, and select View Code from the context menu. See screenshot:

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

VBA code: Send email through Outlook based on cell value in Excel

Dim xRg As Range
'Update by Extendoffice 2018/3/7
Private Sub Worksheet_Change(ByVal Target As Range)
    On Error Resume Next
    If Target.Cells.Count > 1 Then Exit Sub
  Set xRg = Intersect(Range("D7"), Target)
    If xRg Is Nothing Then Exit Sub
    If IsNumeric(Target.Value) And Target.Value > 200 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

Notes:

1. In the VBA code, D7 and value > 200 are the cell and cell value 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. And specify the Cc and Bcc recipients as you need in .CC = “” and Bcc = “” sections.

5. Finally change the email subject in line .Subject = "send by cell value test".

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

From now on, when the value you entering in cell D7 is greater than 200, an email with specified recipients and body will be created automatically in Outlook. You can click the Send button to send this email. See screenshot:

Notes:

1. The VBA code is only working when you use Outlook as your email program.

2. If the entered data in cell D7 is a text value, the email window will be popped out as well.

The Send Emails utility of Kutools for Excel helps users sending email through Outlook based on created mailing list in Excel.
Download and try it now! ( 30-day free trail)

The Best Office Productivity Tools

Kutools for Excel Solves Most of Your Problems, and Increases Your Productivity by 80%

Reuse: Quickly insert complex formulas, charts and anything that you have used before; Encrypt Cells with password; Create Mailing List and send emails...
Super Formula Bar (easily edit multiple lines of text and formula); Reading Layout (easily read and edit large numbers of cells); Paste to Filtered Range...
Merge Cells/Rows/Columns without losing Data; Split Cells Content; Combine Duplicate Rows/Columns... Prevent Duplicate Cells; Compare Ranges...
Select Duplicate or Unique Rows; Select Blank Rows (all cells are empty); Super Find and Fuzzy Find in Many Workbooks; Random Select...
Exact Copy Multiple Cells without changing formula reference; Auto Create References to Multiple Sheets; Insert Bullets, Check Boxes and more...
Extract Text, Add Text, Remove by Position, Remove Space; Create and Print Paging Subtotals; Convert Between Cells Content and Comments...
Super Filter (save and apply filter schemes to other sheets); Advanced Sort by month/week/day, frequency and more; Special Filter by bold, italic...
Combine Workbooks and WorkSheets; Merge Tables based on key columns; Split Data into Multiple Sheets; Batch Convert xls, xlsx and PDF...
More than 300 powerful features. Supports Office/Excel 2007-2019 and 365. Supports all languages. Easy deploying in your enterprise or organization. Full features 30-day free trial. 60-day money back guarantee.

Read More... Free Download... Purchase...

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!

Read More... Free Download... Purchase...

193 Comments
Login

Sort by Newest
- Best
- Popular
- Newest
- Oldest

You are guest

or post as a guest, but your post won't be published automatically.

Loading comment... The comment will be refreshed after 00:00.

To post as a guest, your comment is unpublished.
jthom2885 · 19 days ago
Hi, I've been able to create an email with content, but now I'm trying to extract data from a specified cell related to the initial query. How do I get that data to show in the email Body with the below code? I've tried linking with a vLookUp function to extract that data. So basically, how do I get in the main example above, "This is line 1" to show the Data being pulled for xData below

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
Dim xData As Object
On Error Resume Next
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set xRg = Range("J:J")
Set xRgSel = Intersect(Target, xRg)
Set xData = Application.WorksheetFunction.VLookup(xRgSel, Range("Data_Table"), 6, False)
ActiveWorkbook.Save
If Not xRgSel Is Nothing Then
Set xOutApp = CreateObject("Outlook.Application")
Set xMailItem = xOutApp.CreateItem(0)
xMailBody = xData & "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") & " in https://textmgmt.sharepoint.com/:x:/r/sites/EmailManagedServiceCollaboration/Documents/(%20Test)%20Shared%20TM%20Tracking%20Document%20-%20Local%20Email%20Campaign.xlsm?d=w7ad2f1404d574b9abb529ec248453f42&csf=1&web=1&e=zg9REc ."

With xMailItem
.To = "jason.thompson@textmanagement.co.uk"
.Subject = "Worksheet modified in Brand Approve Column "
.Body = xMailBody
.Send
End With
Set xRgSel = Nothing
Set xOutApp = Nothing
Set xMailItem = Nothing
End If
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
- Reply
To post as a guest, your comment is unpublished.
DavidD · 2 months ago
Hi, I am stuck with a piece of Code. I have combined a few comments below but can't get it to work
I have added the xtarget part of the code in the Mail_small_text_Outlook to select a specific cell to be included as subject
As a result, nothing works anymore. Could someone help please

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("AC9"), Target)
If xRg Is Nothing Then Exit Sub
If Target.Value = 1 Then
ActiveSheet.Calculate
Call Mail_small_Text_Outlook
End If
End Sub

Sub Mail_small_Text_Outlook(xTarget As Range)
Dim xOutApp As Object
Dim xOutMail As Object
Dim xMailBody As String
Dim xR
xR = xTarget.Row
Set xOutApp = CreateObject("Outlook.Application")
Set xOutMail = xOutApp.CreateItem(0)
xMailBody = ""
On Error Resume Next
With xOutMail
.To = "email"
.CC = ""
.BCC = ""
.Subject = Cells(xR, 1).Value
.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 xI As Integer
Dim xRg As Range
Set xRg = Range("AC9")
On Error GoTo Err01
xI = Int(xRg.Value)
If xI = 1 Then
Call Mail_small_Text_Outlook
End If
Err01:
End Sub
- Reply
To post as a guest, your comment is unpublished.
Yolandivdberg@gmail.com · 3 months ago
Good day,
Thank you for teaching me something new, I am trying to get excel to send out an email to different sales reps.
So if row X is an error code of "999" then it needs to send an email to the rep I placed the email addresses in row K as it differs for every line, but if row X is "0" it should not send an email.
is this possible?
- Reply
To post as a guest, your comment is unpublished.
Alicia · 4 months ago
hello
is there a way to have the value be percentage instead of numeric?
- Reply
To post as a guest, your comment is unpublished.
Brandon · 4 months ago
Thank you for the fantastic VBA coding, i am learning quite a bit. As I am a little "green" with this skill, i am currently trying to have the macro choose between doing nothing, or sending one of two different email to send based on a cell value. If the cell has noting in it then "do nothing", if the cell has a "1" or a "2" in it choose either "Mail_small_Text_Outlook()" or "Mail_small_Text_Outlook_2()". I can not figure this out and i am reaching out to see if there are some brighter minds that could help me with this.

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Target.Cells.Count > 1 Then Exit Sub
Set xRg = Intersect(Range("N5"), Target)
If xRg Is Nothing Then Exit Sub

If IsNumeric(Target.Value) And Target.Value = 1 Then
Call Mail_small_Text_Outlook
Exit Sub
ElseIf IsNumeric(Target.Value) And Target.Value = 2 Then
Call Mail_small_Text_Outlook_2
Exit Sub

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 = "" & vbNewLine & vbNewLine & _

On Error Resume Next
With xOutMail
' .SentOnBehalfOfName = ""
.To = ""
.CC = ""
.BCC = ""
.Subject = ""
.Body = xMailBody
.Display 'or use .Send
End With
On Error GoTo 0
Set xOutMail = Nothing
Set xOutApp = Nothing
End Sub

Sub Mail_small_Text_Outlook_2()
Dim xOutApp As Object
Dim xOutMail As Object
Dim xMailBody As String
Set xOutApp = CreateObject("Outlook.Application")
Set xOutMail = xOutApp.CreateItem(0)
xMailBody = "" & vbNewLine & vbNewLine & _

On Error Resume Next
With xOutMail
' .SentOnBehalfOfName = ""
.To = ""
.CC = ""
.BCC = ""
.Subject = ""
.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 xI As Integer
Dim xRg As Range
Set xRg = Range("N5")
On Error GoTo Err01
xI = Int(xRg.Value)
If xI = 1 Then
Call Mail_small_Text_Outlook
End If
Err01:
End Sub
- Reply
To post as a guest, your comment is unpublished.
reeti jaswal · 5 months ago
hello
i want to send automatic emails when due date come to the concern departments.
i have to apply this to 3 or 4 columns
can you please send me code
- Reply
- To post as a guest, your comment is unpublished.
  crystal · 5 months ago
  
  Good day,
  The method in below article may do you a favor. Please have a look:
  How To Send Email If Due Date Has Been Met In Excel?
  https://www.extendoffice.com/documents/excel/4664-excel-send-email-if-due-date-has-been-met.html
  
  Reply
To post as a guest, your comment is unpublished.
Ckey1990 · 6 months ago
Hello,

If for example a cell in column D is filled in to meet the criteria to auto generate an email. Can this be adapted to pull the information from the row in which has been filled in.

ie D7 is filled in so email the contents of A7, B7, C7

ie D25 is filled in so email the contents of A25, B25, C25

Thanks
- Reply
- To post as a guest, your comment is unpublished.
  crystal · 6 months ago
  
  Hi Ckey1990,
  The below code can do you a favor, please have a try. Thank you.
  
  Dim xRg As Range 'Update by Extendoffice 2020/8/28 Private Sub Worksheet_Change(ByVal Target As Range) On Error Resume Next If Target.Cells.Count > 1 Then Exit Sub Set xRg = Intersect(Range("D:D"), Target) If xRg Is Nothing Then Exit Sub If Target.Value = "Done" Then Call Mail_small_Text_Outlook(Target) End If End Sub Sub Mail_small_Text_Outlook(xTarget As Range) Dim xOutApp As Object Dim xOutMail As Object Dim xMailBody As String Dim xR xR = xTarget.Row Set xOutApp = CreateObject("Outlook.Application") Set xOutMail = xOutApp.CreateItem(0) xMailBody = "Hi there" & vbNewLine & vbNewLine & _ Cells(xR, 1).Value & vbNewLine & _ Cells(xR, 2).Value & vbNewLine & _ Cells(xR, 3).Value & vbNewLine 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
  
  Reply
To post as a guest, your comment is unpublished.
Tyson Nold · 6 months ago
I posted before and got a great answer...but moving forward i need more info. I have coulmn "C" listed with 25 different emails. I have column "D" "E" & "F" used for date completions (ex. August 17 = 081720). I need the email body to be different for each of the DEF cells but only go to ONE email in that coresponding row once entered

D3..(EMAIL A) to c3 address, E3(EMAIL B) to c3 address, F3 (EMAIL C) to c3 address

D4..(EMAIL A) to c4 address, E4(EMAIL B) to c4 address, F4 (EMAIL C) to c4 address...

Does this make sense?
- Reply
To post as a guest, your comment is unpublished.
Saybier@gmail.com · 6 months ago
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 (the code do not works in this case). I would also like the email body to populate data from the other cells for that line item how would I get it to pull that cell data in reference to the cell that created the email?

Any help would be fantastic!
- Reply
- To post as a guest, your comment is unpublished.
  crystal · 6 months ago
  
  Hi Mladen,
  I can only help to solve the formula problem for you. Please have a try. Thank you!
  
  Dim xRg As Range
  'Update by Extendoffice 2020/08/21
  Private Sub Worksheet_Change(ByVal Target As Range)
  On Error Resume Next
  If Target.Cells.Count > 1 Then Exit Sub
  Set xRg = Intersect(Range("D7"), Target)
  If xRg Is Nothing Then Exit Sub
  If IsNumeric(Target.Value) And Target.Value > 200 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 xI As Integer
  Dim xRg As Range
  Set xRg = Range("D7")
  On Error GoTo Err01
  xI = Int(xRg.Value)
  If xI > 200 Then
  Call Mail_small_Text_Outlook
  End If
  Err01:
  End Sub
  
  Reply
To post as a guest, your comment is unpublished.
Thais · 6 months ago
Hi !

I have managed to get the coding up and running. However I would like to have the "from" fix from one of my accounts. Several people will be creating this autoresponse so I need to have a fixed "from"

Thank you in advance!
- Reply
- To post as a guest, your comment is unpublished.
  crystal · 6 months ago
  
  Hi Thais,
  The email will be sent with the default account in your Outlook. If you need a fixed "from", please get into the account settings dialog in your Outlook, and then specify the account as the default one.
  
  Reply
  
  To post as a guest, your comment is unpublished.
  
  Thais · 6 months ago
  
  Hi Crystal!
  
  Thank you for the tip :-)
  
  The issue is that the code for sending the email is on a shared excel. People who mighty choose to send the automated email from this shared excel, are most often not the ones who might be able to answer if someone replies to the automated email. Therefore I would like the automated email to always be from a fixed email, in that way we avoid peopel who send the automated email to get questions. Do you know if this can be fixed? I mean, in the code you can choose the to: and subject:, shouldnt we be able to design the :from?
  
  Reply
  
  To post as a guest, your comment is unpublished.
  
  crystal · 6 months ago
  
  Hi Thais,
  I got your point. It just like sending an email on behalf of someone.
  Please add the below line to the code, and don't forget to specify the email address. (After running the code, you will see the From field has a fixed email address)
  .SentOnBehalfOfName = "Email Address"
  The whole VBA code is as follows.
  Dim xRg As Range 'Update by Extendoffice 20120/8/28 Private Sub Worksheet_Change(ByVal Target As Range) On Error Resume Next If Target.Cells.Count > 1 Then Exit Sub Set xRg = Intersect(Range("D7"), Target) If xRg Is Nothing Then Exit Sub If IsNumeric(Target.Value) And Target.Value > 200 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 .SentOnBehalfOfName = "Email Address" .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
  
  Reply
To post as a guest, your comment is unpublished.
Nicolas Molina · 7 months ago
Thank you for the code ! I'm having a small issue where the code will only select the first cell that meets my criteria
( I want to flag any tasks that are late so were due before the current date, however the code is only taking the first value and not all the values in my excle"

the following is my code, i would be forever grateful if you could help!

Public Sub Late_Task_Email()
'Updated by Extendoffice 2018/11/22
Dim xRgDate As Range
Dim xRgSend As Range
Dim xRgText As Range
Dim xRgDone As Range
Dim xOutApp As Object
Dim xMailItem As Object
Dim xLastRow As Long
Dim vbCrLf As String
Dim xMailBody As String
Dim xRgDateVal As String
Dim xRgSendVal As String
Dim xMailSubject As String
Dim xStrRang As String

Dim i As Long

On Error Resume Next

Set xRgDate = Range("F12:F500")
Set xRgDate = Range(xStrRang)

Set xRgSend = Range("B12:B500")
Set xRgSend = Range(xStrRang)

Set xRgText = Range("A12:A500")
Set xRgText = Range(xStrRang)

xLastRow = xRgDate.Rows.Count

Set xRgDate = xRgDate(1)
Set xRgSend = xRgSend(1)
Set xRgText = xRgText(1)
Set xOutApp = CreateObject("Outlook.Application")
For i = 1 To xLastRow
xRgDateVal = ""
xRgDateVal = xRgDate.Offset(i - 1).Value
If xRgDateVal <> "" Then
If CDate(xRgDateVal) - Date < 0 Then
xRgSendVal = xRgSend.Offset(i - 1).Value
xMailSubject = xRgText.Offset(i - 1).Value & " on " & xRgDateVal
vbCrLf = "

"
xMailBody = ""
xMailBody = xMailBody & "Dear DOE,"
xMailBody = xMailBody & "This task is OVERDUE!"
xMailBody = xMailBody & ""
Set xMailItem = xOutApp.CreateItem(0)
With xMailItem
.Subject = xMailSubject
.To = xRgSendVal
.HTMLBody = xMailBody
.Display
'.Send
End With
Set xMailItem = Nothing
End If
End If
Next
Set xOutApp = Nothing
End Sub
- Reply
- To post as a guest, your comment is unpublished.
  crystal · 6 months ago
  
  Hi Nicolas Molina,
  Maybe the code in this tutorial can help you solve the problem:
  How To Send Email If Due Date Has Been Met In Excel?
  https://www.extendoffice.com/documents/excel/4664-excel-send-email-if-due-date-has-been-met.html
  
  Reply
To post as a guest, your comment is unpublished.
Kyle · 7 months ago
Hi Crystal, thank you for sharing this awesome code! I changed the code to function with text so when a cell has anything typed in, it prompts the email function. My question is, how can I code the email to auto-populate the row and column header info for a specific cell along with text? Here are the ranges of data with text:

Subject "(A3:A50) - (Q1:AC1) - Pending"
Mail Body "(P1:AB1) complete."
"Please prepare the (Q1:AC1)"

'Update by Extendoffice 2018/3/7
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Target.Cells.Count > 1 Then Exit Sub
Set xRg = Intersect(Range("P3:AB50"), Target)
If xRg Is Nothing Then Exit Sub
If Target.Value > 0 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 = "Hello," & vbNewLine & vbNewLine & _
"Create Bid Comparison step complete." & vbNewLine & _
"Please prepare the Recommendation of Award." & vbNewLine & vbNewLine & _
"Thank you"
On Error Resume Next
With xOutMail
.To = ""
.CC = ""
.BCC = ""
.Subject = ("Project 20-20")
.Body = xMailBody
.Display 'or use .Send
End With
On Error GoTo 0
Set xOutMail = Nothing
Set xOutApp = Nothing
End Sub
- Reply
- To post as a guest, your comment is unpublished.
  Kyle · 7 months ago
  
  To better clarify, I am hoping to auto-populate the column and row headers into the email, along with text.
  
  Subject "(A3:A50) - (Q1:AC1) - Pending"
  Mail Body "(P1:AB1) complete."
  "Please prepare the (Q1:AC1)"
  
  (i.e. C12, the headers for the subject line would be A12 and C1. C12 for the 1st line in the "Mail Body" and D12 for the 2nd.)
  
  This way, any cell I enter data into will prompt the email and pull the headers in pertaining to that cell.
  
  Thank you!
  
  Reply
To post as a guest, your comment is unpublished.
Mladen · 7 months ago
Hello
I need a help. I use VB code for automatically to send email based on cell value in Excel. The thing is that 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 (the code do not works in this case). Ex.
- Reply
To post as a guest, your comment is unpublished.
shondap · 7 months ago
Hey Crystal,

I'd like to set automatic emails based on drop options of Update Request, Complete or More Info in Cell I. Update Request will send an email to three different email addresses and Complete or More Info will send an email to one email address. Also, how do to I write each Range to equal data that corresponds to the row with the drop down option.

My data below only triggers off Update Request for a specific range (b3). Help!

Dim xRg As Range
'Update by Extendoffice 2018/3/7
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Target.Cells.Count > 1 Then Exit Sub
Set xRg = Intersect(Range("I:I"), Target)
If xRg Is Nothing Then Exit Sub
If Target.Value = "Update Request" 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 = "All," & vbNewLine & vbNewLine & _
"Updates have been entered into the maintenance log:" & vbNewLine & _
Range("b3") & vbNewLine & _
Range("c3") & vbNewLine & _
Range("d3") & vbNewLine & vbNewLine & _
"Thanks," & vbNewLine & _
"Training Team"
With xOutMail
.To = "ShondaX@yahoo.com"
.CC = ""
.BCC = ""
.Subject = "Log Update Requests"
.Body = xMailBody
.Display 'or use .Send
End With
On Error GoTo 0
Set xOutMail = Nothing
Set xOutApp = Nothing
End Sub

Thanks, Shonda
- Reply
To post as a guest, your comment is unpublished.
fari · 7 months ago
hi there
i have a table in excel file
i need to email it row by row
can you help me?
- Reply
To post as a guest, your comment is unpublished.
Tyson nold · 7 months ago
Is there a way to send emails to individual recipients that can be pulled from another cell in the same row?
- Reply
- To post as a guest, your comment is unpublished.
  crystal · 7 months ago
  
  Hi Tyson nold,
  Supposing the recipient's email address is in F7, please apply the below code.
  
  Dim xRg As Range
  'Update by Extendoffice 2020/7/17
  Private Sub Worksheet_Change(ByVal Target As Range)
  On Error Resume Next
  If Target.Cells.Count > 1 Then Exit Sub
  Set xRg = Intersect(Range("D7"), Target)
  If xRg Is Nothing Then Exit Sub
  If IsNumeric(Target.Value) And Target.Value > 200 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 = Range("F7")
  .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
  
  Reply
  
  To post as a guest, your comment is unpublished.
  
  Saybier@gmail.com · 6 months ago
  
  That only pulled the information for that cell. If you are only sending one email for the D7 cell this works but how do you get it to change to another cell for the next value in column D? As in if the next value over 200 is D10 how do you get the email to auto pull the information from F10 instead of F7? That's the issue I'm running into right now.
  
  Thank you!
  
  Reply
  
  To post as a guest, your comment is unpublished.
  
  Mike · 7 months ago
  
  I'm not Tyson, but found it helpful (along with the whole tutorial). Thank you!
  
  Reply
To post as a guest, your comment is unpublished.
Gary · 9 months ago
Hi, I am using the above code to send auto-generated emails when a cell from range G4:G999, how could I add the value(text) from the adjacent cell in range A4:A999 to the xMailBody on the generated email?
Many thanks,
G
- Reply
To post as a guest, your comment is unpublished.
Brittany · 9 months ago
I want my email to send when any of the cells in row H are changed to a specific value, which is one of 3 drop down options (Ready for Inventory) set for that row. How do I modify this coding to that instead of a manually entered value? Thanks!!
- Reply
- To post as a guest, your comment is unpublished.
  crystal · 8 months ago
  
  Hi Brittany,
  Supposing there are drop down lists in column H, and you want to trigger an email when selecting "Done" from the drop-down, please try the below VBA to get it down.
  
  Dim xRg As Range
  'Update by Extendoffice 2020/6/12
  Private Sub Worksheet_Change(ByVal Target As Range)
  On Error Resume Next
  If Target.Cells.Count > 1 Then Exit Sub
  Set xRg = Intersect(Range("H:H"), Target)
  If xRg Is Nothing Then Exit Sub
  If Target.Value = "Done" 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
  
  Reply
  
  To post as a guest, your comment is unpublished.
  
  Mladen · 7 months ago
  
  HelloI need a help. I use VB code for automatically to send email based on cell value in Excel. The thing is that 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 (the code do not works in this case).
  
  Reply
  
  To post as a guest, your comment is unpublished.
  
  crystal · 6 months ago
  
  Hi Mladen,
  Try the below code.
  
  Dim xRg As Range
  'Update by Extendoffice 2012/08/07
  Private Sub Worksheet_Change(ByVal Target As Range)
  On Error Resume Next
  If Target.Cells.Count > 1 Then Exit Sub
  Set xRg = Intersect(Range("D7"), Target)
  If xRg Is Nothing Then Exit Sub
  If IsNumeric(Target.Value) And Target.Value > 200 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 xI As Integer
  Dim xRg As Range
  Set xRg = Range("D7")
  On Error GoTo Err01
  xI = Int(xRg.Value)
  If xI > 200 Then
  Call Mail_small_Text_Outlook
  End If
  Err01:
  End Sub
  
  Reply
  
  To post as a guest, your comment is unpublished.
  
  Mladen · 6 months ago
  
  Thanks! It works.
  
  Reply
  
  To post as a guest, your comment is unpublished.
  
  Saybier@gmail.com · 6 months ago
  
  This is great but I need it to pull information from other cells on the same row that is triggering the email... Can anyone help?
  
  Reply
  
  To post as a guest, your comment is unpublished.
  
  Shonda · 7 months ago
  
  What if there are two options in the drop down list Update and Complete? How would the code look? What if each had its own email that would to be sent based on the action?
  
  Reply
To post as a guest, your comment is unpublished.
dave · 9 months ago
Hi
I am trying to do this type of automatic email button a true or false question true than the form does nothing but false then the form to automatically email out
Can you help ??
- Reply
To post as a guest, your comment is unpublished.
darkgyft · 11 months ago
Cystal,

This is definitely a time saver. I want to know what I would have to add to the vba to include my signature line on the outgoing email. On my usual emails, I have a signature line with company logo and contact info. I want to include that so the email looks just like it would if I had sent myself manually from Outlook. Many thanks!

Mike
- Reply
- To post as a guest, your comment is unpublished.
  crystal · 9 months ago
  
  Hi darkgyft.
  Try the below VBA code. Hope I can help. thank you.
  
  Dim xRg As Range
  'Update by Extendoffice 2020/05/22
  Private Sub Worksheet_Change(ByVal Target As Range)
  On Error Resume Next
  If Target.Cells.Count > 1 Then Exit Sub
  Set xRg = Intersect(Range("D7"), Target)
  If xRg Is Nothing Then Exit Sub
  If IsNumeric(Target.Value) And Target.Value > 200 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)
  On Error Resume Next
  With xOutMail
  .Display 'or use .Send
  .To = "Email Address"
  .CC = ""
  .BCC = ""
  .Subject = "send by cell value test"
  .HTMLBody = "This is a test email sending in Excel" & "
  " & .HTMLBody
  End With
  On Error GoTo 0
  Set xOutMail = Nothing
  Set xOutApp = Nothing
  End Sub
  
  Reply
To post as a guest, your comment is unpublished.
thumsri@gmail.com · 11 months ago
Hi - I tried to use the code, it works fine when cell value D7 is changed manually. if D7 value changed using any formula i.e vlookup or IF .code doesnt trigger. Code trigger only when any cell on the sheet is change keeping D7 value above 200. is there any wayout for the problem . regards srini
- Reply
- To post as a guest, your comment is unpublished.
  crystal · 9 months ago
  
  Hi,
  The below VBA code can help you solve the problem. Please have a try. Thank you.
  
  Dim xRg As Range
  'Update by Extendoffice 20120/5/22
  Private Sub Worksheet_Change(ByVal Target As Range)
  On Error Resume Next
  If Target.Cells.Count > 1 Then Exit Sub
  Set xRg = Intersect(Range("D7"), Target)
  If xRg Is Nothing Then Exit Sub
  If IsNumeric(Target.Value) And Target.Value > 200 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 xI As Integer
  Dim xRg As Range
  Set xRg = Range("D7")
  On Error GoTo Err01
  xI = Int(xRg.Value)
  If xI > 200 Then
  Call Mail_small_Text_Outlook
  End If
  Err01:
  End Sub
  
  Reply
To post as a guest, your comment is unpublished.
Stephanie · 1 years ago
Hi All,
I'm trying to connect all these actions by clicking a button instead of running it each time. Does anybody know how to do this?
- Reply
To post as a guest, your comment is unpublished.
Bob · 1 years ago
Hi! How can I send the e-mails without accepting them at outlook. And they sand automatically without knowing.
- Reply
To post as a guest, your comment is unpublished.
lynsey · 1 years ago
Hi all - I am trying to use this code but when I exit the developer and test the cell- it is over the specifications, but nothing happens. I don't receive a pop up to send the email? But when I run the code in developer it comes up - its just when I'm within the spreadsheet and change the cell, nothing happens. I have copied and edited the code as per instructions.
- Reply
To post as a guest, your comment is unpublished.
karthick · 1 years ago
Dear all kindly help me …… my requirement as follow..!!

I will be having a workbook in which there will be set of data

then i'll be manually entering a date as a value in a cell
when the actual date matches with my manual entered date
excel has to automatically trigger a mail in OUTLOOK with so and so data along with a body of letter to recipient and also cc

thanks a lot in advance
- Reply
To post as a guest, your comment is unpublished.
raguirre76@gmail.com · 1 years ago
How can I refer to a cell on the worksheet to include in the email automatically?
- Reply
- To post as a guest, your comment is unpublished.
  crystal · 1 years ago
  
  Hi Robert,
  Supposing you want to refer to cell A7 on the worksheet, please apply the below code.
  
  Dim xRg As Range
  'Update by Extendoffice 2019/12/13
  Private Sub Worksheet_Change(ByVal Target As Range)
  On Error Resume Next
  If Target.Cells.Count > 1 Then Exit Sub
  Set xRg = Intersect(Range("D7"), Target)
  If xRg Is Nothing Then Exit Sub
  If IsNumeric(Target.Value) And Target.Value > 200 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 Rng = Selection.SpecialCells(xlCellTypeVisible)
  Set xOutApp = CreateObject("Outlook.Application")
  Set xOutMail = xOutApp.CreateItem(0)
  xMailBody = "Hi there" & vbNewLine & vbNewLine & _
  Range("A7") & vbNewLine & _
  "Best Regards"
  
  On Error Resume Next
  With xOutMail
  .To = ""
  .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
  
  Reply
To post as a guest, your comment is unpublished.
tarti.s689@gmail.com · 1 years ago
Crystal you're the best.

I want to download the data to be checked with a SQL query, what do I have to do to make the code below work then, at the moment it only works manually.
Thank you

Private Sub Worksheet_Change(ByVal Target As Range)
Dim xRg As Range
On Error Resume Next
If (Target.Count > 1) Then Exit Sub
Set xRg = Intersect(Target, Range("Z:Z"))
If xRg Is Nothing Then Exit Sub
If UCase(Target.Value) = "HOT" Then
Call Mail_small_Text_Outlook(Target)
End If
End Sub
Sub Mail_small_Text_Outlook(ByVal xCell As Range)
Dim xOutApp As Object
Dim xOutMail As Object
Dim xMailBody As String
Set xOutApp = CreateObject("Outlook.Application")
Set xOutMail = xOutApp.CreateItem(0)
xMailBody = "Hello Team" & vbNewLine & vbNewLine & _
"Lot " & Range("D" & xCell.Row) & "'s Priority has changed to HOT, please prioritize this lot."
On Error Resume Next
With xOutMail
.To = "Email Address1; Email Address2; Email Address3; Email Address4; Email Address5"
.CC = ""
.BCC = ""
.Subject = "Lot number is " & Range("D" & xCell.Row)
.Body = xMailBody
.Display 'or use .Send
End With
On Error GoTo 0
Set xOutMail = Nothing
Set xOutApp = Nothing
End Sub
- Reply
To post as a guest, your comment is unpublished.
Nano22 · 1 years ago
Crystal you're the best.
what do i have to add to make the code work with formulas ?
Thank you

Private Sub Worksheet_Change(ByVal Target As Range)
Dim xRg As Range
On Error Resume Next
If (Target.Count > 1) Then Exit Sub
Set xRg = Intersect(Target, Range("B:B"))
If xRg Is Nothing Then Exit Sub
If UCase(Target.Value) = "Yes" Then
Call Mail_small_Text_Outlook(Target)
End If
End Sub
Sub Mail_small_Text_Outlook(ByVal xCell As Range)
Dim xOutApp As Object
Dim xOutMail As Object
Dim xMailBody As String
Set xOutApp = CreateObject("Outlook.Application")
Set xOutMail = xOutApp.CreateItem(0)
xMailBody = "Hello Team" & vbNewLine & vbNewLine & _
"Lot " & Range("A" & xCell.Row) & "'s Priority has changed to Yes, please prioritize this lot."
On Error Resume Next
With xOutMail
.To = "Email Address1; Email Address2; Email Address3; Email Address4; Email Address5"
.CC = ""
.BCC = ""
.Subject = "Lot number is " & Range("A" & xCell.Row)
.Body = xMailBody
.Display 'or use .Send
End With
On Error GoTo 0
Set xOutMail = Nothing
Set xOutApp = Nothing
End Sub
- Reply
To post as a guest, your comment is unpublished.
prasana05@gmail.com · 1 years ago
I need help with Excel to send an automatic email using outlook when a cell value is changed in the file.

Question . Sheet name "Attrition Report" Column L in the file has the list of RAG status, So, when one of the manager will choose the options (Green, Red, Amber) for possible attrition cases. When the cell value changes to Red or Amber ; excel should automatically send an email ONLY when it changes to RED or Amber. The body of the email should show employee name which is in Cell range "B" and the RAG status which is in Range "L".
I put the code but i guess it's incorrect.

Any help on this will be much appreciated.

Thanks and Regards

Emanuel Prasanna Kumar

The code i currently have. is.

_______________

Dim xRg As Range
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Target.Cells.Count > 1 Then Exit Sub
For Each xRg In Range("L2:L100")
If CInt(xRg.Value) = "Red" And "Amber" Then
Call Mail_small_Text_Outlook
End If
Next
End Sub
Sub Mail_small_Text_Outlook()
Dim xOutApp As Object
Dim xOutMail As Object
Dim xMailBody As String
Dim xIntR As Integer
xIntR = xRg.Row
Set xOutApp = CreateObject("Outlook.Application")
Set xOutMail = xOutApp.CreateItem(0)
xMailBody = "Hi there" & vbNewLine & vbNewLine & _
"Emp Name. :" & Range("B" & xIntR).Value & vbNewLine & _
"RAG Status :" & Range("L" & xIntR).Value & vbNewLine & _
"Factor :" & Range("K" & xIntR).Value & vbNewLine
On Error Resume Next
With xOutMail
.To = "Emanuel.Kumar@infovision.com"
.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
- Reply
To post as a guest, your comment is unpublished.
rajeshwariagale04@gmail.com · 1 years ago
How can I display the Sheet name and list of cells which has value more than 200 in the email content?
- Reply
To post as a guest, your comment is unpublished.
ClaireC · 1 years ago
Hello,
How do I get excel to send an email automatically when the worksheet is opened based on a cell value?
- Reply
To post as a guest, your comment is unpublished.
Claire · 1 years ago
Hello,

How can i get excel to send an email automatically when the workbook is opened based on a cell value, instead of when the cell value is changed?
- Reply
To post as a guest, your comment is unpublished.
joseph · 1 years ago
I want to add different email address per row, but when I change one row, the entire worksheet changes. How can I limit the changes only to one row each per one email account?
- Reply
To post as a guest, your comment is unpublished.
mshreyascse@gmail.com · 1 years ago
Hi All,
Can someone help me to figure out the below
I have an Excel sheet with loads of worksheets in it.
Data is entered in 3 worksheets on daily basis and information from these 3 sheets is sent out to mailing list on every Sunday (data accumulated from Last Sunday to Saturday in those 3 work sheets).
This XL sheet is stored in share point.
- Reply
To post as a guest, your comment is unpublished.
Katie · 1 years ago
Hi Crystal,
Thank you for this code. It is extremely helpful. I am trying to add a few things to it and was wondering if you or someone following this post could help.

How can you add Cell Text from the same Range (row) to the Mail Body?
How can you get the code to send an email for every Cell in the Range that is over an amount?

Thank you so much!
- Reply
To post as a guest, your comment is unpublished.
RobArchibald · 1 years ago
Hi Crystal,
Thank you for your extremely useful posts! I have the VBA code working perfectly for our purposes, except for one problem - when I open the workbook or make a change, each email is created twice. What can be done to ensure each email is only created once?

Many thanks, Rob

My current code:

Dim xRg As Range
'Update by Extendoffice 2019/8/2
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Target.Cells.Count > 1 Then Exit Sub
Set xRg = Intersect(Range("A1"), Target)
If xRg Is Nothing Then Exit Sub
If IsNumeric(Target.Value) And Target.Value = 1 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 = "Dear " & Range("C3") & "," & vbNewLine & vbNewLine & _
"I am writing to inform you that the Form D filing for " & Range("C2") & " is due on " & Range("C4") & ". All securities offerings that rely on the exemptions set forth under Regulation D are required to file a Form D every year for as long as the offering is open." & vbNewLine & vbNewLine & _
"It is advised that " & Range("C2") & " should maintain its Form D filing if it continues to offer securities in reliance on Regulation D. Maintaining an up-to-date Form D is important in ensuring compliance with federal and state securities regulations." & vbNewLine & vbNewLine & _
"Please let us know at your earliest convenience if you wish to arrange the renewal of the Form D." & vbNewLine & vbNewLine & _
"Thank you," & vbNewLine
On Error Resume Next
With xOutMail
.To = Range("C5")
.CC = "t.kim@geracillp.com"
.BCC = ""
.Subject = "Form D filing notice for " & Range("C2")
.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 xI As Integer
Dim xRg As Range
Set xRg = Range("A1")
On Error GoTo Err01
xI = Int(xRg.Value)
If xI = 1 Then
Call Mail_small_Text_Outlook
End If
Err01:
End Sub
- Reply
- To post as a guest, your comment is unpublished.
  RobArchibald · 1 years ago
  
  Actually, more to the point - how do I make it so that only one email is created when I open the workbook, but not just when I make a change to it? Currently changing any cell results in a new email being created.
  
  Please help with this last hurdle, I'm so close!
  
  Reply
To post as a guest, your comment is unpublished.
Viji · 1 years ago
How to insert the images in email body
- Reply
To post as a guest, your comment is unpublished.
Edward · 1 years ago
I Keep Getting this:

Run-time error '429':

ActiveX component can't create object

I use apple and don't have outlook... is there a way to make this work without outlook.. and

instead Mail Version 11.5 (3445.9.1) apple
- Reply
- To post as a guest, your comment is unpublished.
  crystal · 1 years ago
  
  Hi Edward,
  The code can't work without Outlook. Sorry for the inconvenience.
  
  Reply
To post as a guest, your comment is unpublished.
Ganesh · 1 years ago
Thank you for posting valuable and important VBA code. I am new in VBA coding and trying to modify your VBA with editing Mail Body;

...
xMailBody = "Hi there" & vbNewLine & vbNewLine & _
"This is line 1" & vbNewLine & _
"This is line 2"
On Error Resume Next
...

How to add Cell Text Ex. text from A7, B7 & C7 related to D7 into Mail Body instead of other text. Could someone please guide me. Thank you in advance.
- Reply
- To post as a guest, your comment is unpublished.
  crystal · 1 years ago
  
  Hi Ganesh,
  Please apply the below code. Hope I can help.
  
  Dim xRg As Range
  'Update by Extendoffice 2019/12/13
  Private Sub Worksheet_Change(ByVal Target As Range)
  On Error Resume Next
  If Target.Cells.Count > 1 Then Exit Sub
  Set xRg = Intersect(Range("D7"), Target)
  If xRg Is Nothing Then Exit Sub
  If IsNumeric(Target.Value) And Target.Value > 200 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 & _
  Range("A7") & vbNewLine & _
  Range("B7") & vbNewLine & _
  Range("C7") & vbNewLine & _
  "Best Regards"
  
  On Error Resume Next
  With xOutMail
  .To = ""
  .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
  
  Reply
  
  To post as a guest, your comment is unpublished.
  
  Guru · 7 months ago
  
  I have the exact situation but only difference is ...I have got around 100 rows to check. So it has to check each row on column D if any cell on column D meets the criteria it has to add info from column A B and C for respective D cell and after checking all 100 rows it has to send one email.
  
  Reply
To post as a guest, your comment is unpublished.
ricardo27 · 1 years ago
I have another question, how do you write in VBA so instead of "If IsNumeric(Target.Value) And Target.Value > 200 Then" (detecting a value greater than 200 it detects any text input..... for example in cell D7 you write any words (not number but words) it calls out the email ! please respond
- Reply
- To post as a guest, your comment is unpublished.
  crystal · 1 years ago
  
  Hi,
  Please replace the line "If IsNumeric(Target.Value) And Target.Value > 200 Then" with "If Target.Value = "test" Then"
  "test" is the specific word you will cal out the email based on, please change it to your own word.
  
  Reply
To post as a guest, your comment is unpublished.
ricardo27 · 1 years ago
Hi

I got a question, on excel I have a column with several emails written (they are formulated), for example A36 is example1@hotmail.com, A37 is example2@hotmail.com, A38 is example3@hotmail.com, I want that the part of the programming VBA To: Range (A36:A38) so they send the email to each of those wroten emails, the thing is that I put it like this To: Range (A36:A38) but it does not work, am I doing it wrong?
- Reply
- To post as a guest, your comment is unpublished.
  crystal · 1 years ago
  
  Hi ricardo suarez,
  The below VBA code can solve your problem. Please have a try and thank you for your comment.
  
  Dim xRg As Range
  'Update by Extendoffice 2019/8/14
  Private Sub Worksheet_Change(ByVal Target As Range)
  On Error Resume Next
  If Target.Cells.Count > 1 Then Exit Sub
  Set xRg = Intersect(Range("D7"), Target)
  If xRg Is Nothing Then Exit Sub
  If IsNumeric(Target.Value) And Target.Value > 200 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
  For Each cell In Range("A36:A38")
  If cell.Value Like "?*@?*.?*" Then
  strto = strto & cell.Value & ";"
  End If
  Next cell
  If Len(strto) > 0 Then strto = Left(strto, Len(strto) - 1)
  Application.ScreenUpdating = False
  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 = strto
  .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
  
  Reply
To post as a guest, your comment is unpublished.
amy786 · 1 years ago
Hi

My vba code works fine, even the email part to outlook. I'm quite chuffed as I am a novice at vba. I created an automated process to create an invoice and email in pdf.

However the next step is I want to include a status on the excel spreadsheet, which is my database to say "complete" or "sent". I'm thinking maybe an IF formula? I don't want to use a message box. Basically I just want to keep record that for each creditor the email has been sent.

How would I do that in VBA

Thanks for your help:)
- Reply
- To post as a guest, your comment is unpublished.
  crystal · 1 years ago
  
  Hi Anisa,
  Sorry can't help you with that. Thank you for your comment.
  
  Reply
To post as a guest, your comment is unpublished.
Roxiann · 1 years ago
Hi. I am trying to use your code and I get the email but I want the email address I have in cell E159 to pop up as the email address. I also want to Display a cell value in the middle of my email. I have tried several ways and none seem to work. I cannot use the kudotools app. I only have excel and the vba.
- Reply
- To post as a guest, your comment is unpublished.
  crystal · 1 years ago
  
  Hi Roxiann,
  Supposing you want to send email to address in cell E159, and display value of cell A1 in your email body, you can try the below VBA code. Thanks for your comment.
  
  Dim xRg As Range
  'Update by Extendoffice 2018/3/7
  Private Sub Worksheet_Change(ByVal Target As Range)
  On Error Resume Next
  If Target.Cells.Count > 1 Then Exit Sub
  Set xRg = Intersect(Range("D7"), Target)
  If xRg Is Nothing Then Exit Sub
  If IsNumeric(Target.Value) And Target.Value > 200 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 & _
  Range("A1") & vbNewLine & _
  "This is line 2"
  On Error Resume Next
  With xOutMail
  .To = Range("E159")
  .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
  
  Reply
To post as a guest, your comment is unpublished.
Otoniel · 1 years ago
Hi Crystal, thanks for the last answer, i got a quick question, how can i add the cell value automatically to the mailbody
- Reply
- To post as a guest, your comment is unpublished.
  crystal · 1 years ago
  
  Or just include this line Range("D7") & vbNewLine & _ in the xMailBody line.
  
  xMailBody = "Hi there" & vbNewLine & vbNewLine & _
  "This is line 1" & vbNewLine & _
  Range("D7") & vbNewLine & _
  "This is line 2"
  
  Reply
  
  To post as a guest, your comment is unpublished.
  
  otorodriguez26@gmail.com · 1 years ago
  
  Thank you very much ! Crystal
  
  Reply
- To post as a guest, your comment is unpublished.
  crystal · 1 years ago
  
  Hi Otoniel,
  Supposing the cell D7 is in the worksheet named "Sheet2", please change the xMailBody line in above code to
  xMailBody = "The value of D7 is" & ThisWorkbook.Sheets("Sheet2").Cells(7, 4).Value
  
  Don't forget to change the sheet name and the cell number as you need (here Cells(7,4) represents cell D7 which locationg in row 7 column 4).
  
  Reply
To post as a guest, your comment is unpublished.
Paras · 1 years ago
This is great but just the last step is not completing my request. Could you please update so it automatically sends out the email, without clicking send.
- Reply
- To post as a guest, your comment is unpublished.
  crystal · 1 years ago
  
  Hi Paras,
  In the code, please replace the .Display line with .Send. Thanks for your comment.
  
  Reply
To post as a guest, your comment is unpublished.
dalton · 1 years ago
I am having a similar issue as has been brought up, the VBA works with manually values. I have 2 workbooks, I hope to pull data from workbook 2 into workbook1. Workbook 1 then subtracts 2 numbers, one of which is pulled from workbook2 (via using formula of =value in cell in workbook 2). Then if the difference is less than a given number, I hope to send an email. When I manually enter the number the VBA works great. When I use the = value of cell in workbook 2, VBA does not run. I feel so close but still out of arms length. Any help is greatly appreciated. Thanks much.
- Reply
To post as a guest, your comment is unpublished.
Otoniel · 1 years ago
Hello is it possible, that instead of popping up the email.

Can it be configured to automatically send the mail, without the need to send it manually?
- Reply
- To post as a guest, your comment is unpublished.
  crystal · 1 years ago
  
  Hi Otoniel,
  In the code, please replace the .Display line with .Send. Thanks for your comment.
  
  Reply
To post as a guest, your comment is unpublished.
Toph42 · 1 years ago
Is there was a way to prompt the email by cells that are populated by a formula? This seems to only work when populating the cells manually. Thanks!
- Reply
- To post as a guest, your comment is unpublished.
  crystal · 1 years ago
  
  Good day,
  The below VBA code will do you a favor.
  
  Dim xRg As Range
  'Update by Extendoffice 2019/8/2
  Private Sub Worksheet_Change(ByVal Target As Range)
  On Error Resume Next
  If Target.Cells.Count > 1 Then Exit Sub
  Set xRg = Intersect(Range("D7"), Target)
  If xRg Is Nothing Then Exit Sub
  If IsNumeric(Target.Value) And Target.Value > 200 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 xI As Integer
  Dim xRg As Range
  Set xRg = Range("D7")
  On Error GoTo Err01
  xI = Int(xRg.Value)
  If xI > 200 Then
  Call Mail_small_Text_Outlook
  End If
  Err01:
  End Sub
  
  Reply
To post as a guest, your comment is unpublished.
Kayden · 1 years ago
I've set this VBA to range instead of a single cell. However, I'd like to specify which cell value has triggered this email to be sent. Let say, Value on D3 is greater than 200, that triggered this email message from range (D1:E20). How can I embed this code into VBA, so I can add this to email subject? any help would be greatly appreciated!
- Reply
- To post as a guest, your comment is unpublished.
  crystal · 1 years ago
  
  Hi Kayden,
  If you want to specify a range of cells rather than single cell, the below VBA code can help. But I don't really understand your last question about "so I can add this to email subject". Thanks for your comment.
  
  Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Cells.Count > 1 Then Exit Sub
  If Intersect(Target, Range("D1:E20")) = Target And Target.Value > 200 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 = ""
  .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
  
  Reply
  
  To post as a guest, your comment is unpublished.
  
  KAYDEN · 1 years ago
  
  Hello Crystal,
  
  Thank you very much for your response! I'd like to elaborate an issue I have. I have a range of cells as "target". When email is generated, on Subject line, I'd like to add a cell that triggered this email. For instance, Qty of Mango fell below target value of 200, then I'd like to add Please order "Mango" on the subject line. Since the target is a range, I'd want some type of formula that can refer to cell B2 (Mango - name of the fruit column). I hope you could help me out on this! Thanks once again!
  
  Reply
  
  To post as a guest, your comment is unpublished.
  
  crystal · 1 years ago
  
  HI KAYDEN,
  Do you mean the subject line is dynamically changed based on the target value of the Qty column? When Qty of Mango fell below target value of 200, send email with subject line "Please order Mango (refers to cell B2)"; When Qty of another fruit fell below target value of 200, send email with subject line of the corresponding fruit name?
  
  Reply
  
  To post as a guest, your comment is unpublished.
  
  Corben Baxter · 5 months ago
  
  Hi Crystal,
  
  When targeting a range of cells... how do you get the automated email to call out "identify" the particular cell that generated the email. I am working on a usage based forklift PM spreadsheet that changes column E to read PM NEEDED after 300hrs. We currently have 27 forklifts (cells E3;E49), your code has worked for me in triggering the email but it would be ideal for the email to identify which cell was the email trigger.
  
  Reply
  
  To post as a guest, your comment is unpublished.
  
  crystal · 4 months ago
  
  Hi,
  Supposing cell D7 is the email trigger, you just need to include this line Range("D7") & vbNewLine & _ in the xMailBody line of the code as follows:
  
  xMailBody = "Hi there" & vbNewLine & vbNewLine & _
  "This is line 1" & vbNewLine & _
  Range("D7") & vbNewLine & _
  "This is line 2"
  
  Reply
  
  To post as a guest, your comment is unpublished.
  
  Corben · 4 months ago
  
  Thank you for your response. This helped out.
  
  Reply
  
  To post as a guest, your comment is unpublished.
  
  Rodrigo · 1 years ago
  
  I think what he's also trying to say (beside the dynamics in the subject of the email) is that by setting a range of cells that can trigger the email, you wont know what that change was and where.
  
  With a single cell instead of a range you'll know exactly where to look once you get the email or you can even add the value that triggered the email in the email body, as I read above by specifying the single cell you're trying to track.
  
  But when you specify a range, how can you add in the body of the email the value and cell or column that started the whole action? How do I know what and where the change happened?
  
  Reply
  
  To post as a guest, your comment is unpublished.
  
  KAYDEN · 1 years ago
  
  Dear Crystal,
  
  Yes, you are correct. I'd like to have a dynamic subject line to reflect the name of fruit! Sorry I was ambiguous on my asking, but you understood perfectly! Do you think there's a code that I can use to make this work? Thank you again for your help!
  
  Reply
To post as a guest, your comment is unpublished.
Dmytro · 1 years ago
Hi! How should I copy/paste the code to get it to work? (after copying/pasting with line number and line text it shows up "invalid outside procedure"; copying/pasting only text lines without line numbers it does nothing after changing the cell value).
- Reply
- To post as a guest, your comment is unpublished.
  crystal · 1 years ago
  
  Hi Dmytro,
  Sorry for the inconvenience. You just need to copy the text lines without the line numbers. The code only works when the criterion met (In this case, when value in cell D7 is changed to more than 200, the code will work).
  Thanks for your comment.
  
  Reply

Login to your account

Password Reset