Hi there,
I need help to trigger an email based on name initials from another cell. Below is a code which only sends an email to me when a value is keyed into col Q. Right now I need to trigger an email if a value has been keyed into col O and col E has the initial and since the email is only sent between 3 different people, I did not place the email addresses in any cells in the workbook. I hope you understand what I am trying to explain.
Initials
TL = Traves_lee@gmail.com
KL = Kris_Loen@gmail.com
RS = Rose@gmail.com
For example if "Test" is the value in Col O1 and the initial TL which belongs to 'Traves_Lee@gmail.com' is in Col E1. It till trigger an email to Traves Lee. Another example would be Col O5 has "Test" and the Initials RS is in E5 it till trigger an email to Rose@gmail.com. Both the value from Col O and initial in Col E are in the same row.
I need help to trigger an email based on name initials from another cell. Below is a code which only sends an email to me when a value is keyed into col Q. Right now I need to trigger an email if a value has been keyed into col O and col E has the initial and since the email is only sent between 3 different people, I did not place the email addresses in any cells in the workbook. I hope you understand what I am trying to explain.
Initials
TL = Traves_lee@gmail.com
KL = Kris_Loen@gmail.com
RS = Rose@gmail.com
For example if "Test" is the value in Col O1 and the initial TL which belongs to 'Traves_Lee@gmail.com' is in Col E1. It till trigger an email to Traves Lee. Another example would be Col O5 has "Test" and the Initials RS is in E5 it till trigger an email to Rose@gmail.com. Both the value from Col O and initial in Col E are in the same row.
VBA Code:
'Update by Extendoffice 2018/3/7
'code to check if cell range in col Q contains string/integer
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
If (Target.Column = Range("Q1").Column) And (Target.Value <> "") Then
Call Mail_small_Text_Outlook(ActiveSheet.Name, Target.Row)
End If
End Sub
Sub Mail_small_Text_Outlook(sheetName As String, changed_RowNumber As Long)
'Code to launch email app (outlook)
Dim xOutApp As Object
Dim xOutMail As Object
Dim xMailBody As String
Dim strbody As String
Set xOutApp = CreateObject("Outlook.Application")
Set xOutMail = xOutApp.CreateItem(0)
'Code for email content
xMailBody = "Hi there" & vbNewLine & vbNewLine & _
"You have a query from: " & Sheets(sheetName).Range("E" & changed_RowNumber).Value & vbNewLine & _
"Case Number: " & Sheets(sheetName).Range("C" & changed_RowNumber).Value & " (" & Sheets(sheetName).Range("D" & changed_RowNumber).Value & ")" & vbNewLine & _
"Thank you"
'Code to auto fill addressess's email address
On Error Resume Next
With xOutMail
.To = "[EMAIL]Linda@gmail.com[/EMAIL]" ' my email address
.CC = ""
.BCC = ""
.Subject = "Pending query processing"
.Body = xMailBody 'this is for email content
.Display 'or use .Send
End With
On Error GoTo 0
Set xOutMail = Nothing
Set xOutApp = Nothing
End Sub
Last edited by a moderator: