Sending email from a cell based on a name initial from another cell

[Sha]

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.

'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

 

[SQUIDD]

Hi

If i understand you correctly then try the below in your sheet module.

If you enter enything into column O, and there is dat in column E then it will should call the email code and email it to the corrosponding person.

Public MAIL_WHO As String
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column <> 15 Then Exit Sub
    If Target.Offset(0, -10) = "" Then Exit Sub
    If Target.Offset(0, -10) = "TL" Then MAIL_WHO = "Traves_lee@gmail.com"
    If Target.Offset(0, -10) = "KL" Then MAIL_WHO = "Kris_Loen@gmail.com"
    If Target.Offset(0, -10) = "RS" Then MAIL_WHO = "Rose@gmail.com"
Call Mail_small_Text_Outlook(ActiveSheet.Name, Target.Row)
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 = MAIL_WHO
.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

 

[Sha]

That is correct. But I would not be able to combine the original codes and the one you had assisted me with right? as there are 2 private subs....

I am so sorry I am really new at all this.

There are 2 different actions that is required in this workbook that I am doing. One is to send an email only to me when anything has been keyed into col Q containing all the information is cols C, D & E. The other would require another email to be sent to the respective staff if anything was to be keyed into Col O which would contain information is Cols C, D, E, G, N and O.

 

[SQUIDD]

Morning, you dont need to appoligise for being new.

So if i understand properly now, try the below.

This is untested,

Put this whole code into your sheet module.

Now if you enter something in Q, in the case below column number 17, then your existing code should run.
If you enter anything into O, in the case below column number 15, the new code will run.

Notice i have added for you to fill out how the body of this email will be as you did in your original code.
Also, i have split out the subject for you to change if you want.

good luck

dave

Public MAIL_WHO As String
Public XMAILBODY As String
Public SUBJECT_MESSAGE As String
Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Column <> 15 Or Target.Column <> 17 Then Exit Sub

If Target.Column = 15 Then
    If Target.Offset(0, -10) = "" Then Exit Sub
    If Target.Offset(0, -10) = "TL" Then MAIL_WHO = "Traves_lee@gmail.com"
    If Target.Offset(0, -10) = "KL" Then MAIL_WHO = "Kris_Loen@gmail.com"
    If Target.Offset(0, -10) = "RS" Then MAIL_WHO = "Rose@gmail.com"
    SUBJECT_MESSAGE = "ADD A SUBJECT" 'ADD A DIFFERENT SUBJECT IF NEEDED
    XMAILBODY = "ADD YOUR BODY MESSAGE" 'EDIT THIS TO BE C, D, E, G, N and O.
End If

If Target.Column = 17 Then
    MAIL_WHO = "Linda@gmail.com"
    SUBJECT_MESSAGE = "Pending query processing"
    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"
End If

Call Mail_small_Text_Outlook(ActiveSheet.Name, Target.Row)

End Sub
Sub Mail_small_Text_Outlook(sheetName As String, changed_RowNumber As Long)

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)

On Error Resume Next
With xOutMail
    .To = MAIL_WHO
    .CC = ""
    .BCC = ""
    .SUBJECT = SUBJECT_MESSAGE
    .Body = XMAILBODY
    .Display
    '.SEND
End With

On Error GoTo 0

Set xOutMail = Nothing
Set xOutApp = Nothing

End Sub

 

[SQUIDD]

Sorry

ignore the above and use the below.

Checked the existing code that you supplied with your ranges and realise they was not compatable.

try the below

Public MAIL_WHO As String
Public XMAILBODY As String
Public SUBJECT_MESSAGE As String
Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Column <> 15 And Target.Column <> 17 Then Exit Sub

If Target.Column = 15 Then
    If Target.Offset(0, -10) = "" Then Exit Sub
    If Target.Offset(0, -10) = "TL" Then MAIL_WHO = "Traves_lee@gmail.com"
    If Target.Offset(0, -10) = "KL" Then MAIL_WHO = "Kris_Loen@gmail.com"
    If Target.Offset(0, -10) = "RS" Then MAIL_WHO = "Rose@gmail.com"
    SUBJECT_MESSAGE = "ADD A SUBJECT" 'ADD A DIFFERENT SUBJECT IF NEEDED
    XMAILBODY = "Hi there" & vbNewLine & vbNewLine & _
        "You have a query from: " & Range("E" & Target.Row).Value & vbNewLine & _
        "Case Number: " & Range("C" & Target.Row).Value & " (" & Range("D" & Target.Row).Value & ")" & vbNewLine & "Thank you" 'EDIT THIS TO INCLUDE G, N and O. AS YOU WANT IT DISPLAYED
End If

If Target.Column = 17 Then
    MAIL_WHO = "Linda@gmail.com"
    SUBJECT_MESSAGE = "Pending query processing"
    XMAILBODY = "Hi there" & vbNewLine & vbNewLine & _
        "You have a query from: " & Range("E" & Target.Row).Value & vbNewLine & _
        "Case Number: " & Range("C" & Target.Row).Value & " (" & Range("D" & Target.Row).Value & ")" & vbNewLine & "Thank you"
End If

Mail_small_Text_Outlook
End Sub
Sub Mail_small_Text_Outlook()

Dim xOutApp As Object
Dim xOutMail As Object

Set xOutApp = CreateObject("Outlook.Application")
Set xOutMail = xOutApp.CreateItem(0)

On Error Resume Next
With xOutMail
    .To = MAIL_WHO
    .Subject = SUBJECT_MESSAGE
    .Body = XMAILBODY
    .Display 'or .send
End With
On Error GoTo 0

Set xOutMail = Nothing
Set xOutApp = Nothing

End Sub

 

[Sha]

Good Morning,

Thank you so much for the help. The code works perfectly. Only issue now is that if either Cols O and Q have content and it was deleted, it still triggers the email command. How do i stop it from happening as it is pretty annoying.

 

[SQUIDD]

Morning

try adding this line

If Target.Value = "" Then Exit Sub

under this line

If Target.Column <> 15 And Target.Column <> 17 Then Exit Sub

This should mean that if you update the cell to balnk, the code will exit.

Dave

 

[Sha]

GOSH! it was just that 1 line. Thank you so much now the sheet works perfectly!

 

[SQUIDD]

Haha. Yep. Just the 1 little line.

Your very welcome and I’m glad we got it all working as expected.

Dave

 

[SQUIDD]

Haha. Yep. Just the 1 little line.

Your very welcome and I’m glad we got it all working as expected.

Dave