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

Sha

New Member
Joined
Oct 6, 2021
Messages
28
Office Version
  1. 2013
Platform
  1. Windows
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.

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:

Excel Facts

Back into an answer in Excel
Use Data, What-If Analysis, Goal Seek to find the correct input cell value to reach a desired result

SQUIDD

Well-known Member
Joined
Jan 2, 2009
Messages
1,942
Office Version
  1. 2019
  2. 2016
Platform
  1. Windows
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.



VBA Code:
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

New Member
Joined
Oct 6, 2021
Messages
28
Office Version
  1. 2013
Platform
  1. Windows
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

Well-known Member
Joined
Jan 2, 2009
Messages
1,942
Office Version
  1. 2019
  2. 2016
Platform
  1. Windows
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

VBA Code:
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

Well-known Member
Joined
Jan 2, 2009
Messages
1,942
Office Version
  1. 2019
  2. 2016
Platform
  1. Windows

ADVERTISEMENT

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

VBA Code:
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
 
Solution

Sha

New Member
Joined
Oct 6, 2021
Messages
28
Office Version
  1. 2013
Platform
  1. Windows
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

Well-known Member
Joined
Jan 2, 2009
Messages
1,942
Office Version
  1. 2019
  2. 2016
Platform
  1. Windows

ADVERTISEMENT

Morning

try adding this line

VBA Code:
If Target.Value = "" Then Exit Sub

under this line

VBA Code:
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

New Member
Joined
Oct 6, 2021
Messages
28
Office Version
  1. 2013
Platform
  1. Windows
GOSH! it was just that 1 line. Thank you so much :love: now the sheet works perfectly!
 

SQUIDD

Well-known Member
Joined
Jan 2, 2009
Messages
1,942
Office Version
  1. 2019
  2. 2016
Platform
  1. Windows
Haha. Yep. Just the 1 little line.

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

Dave
 

SQUIDD

Well-known Member
Joined
Jan 2, 2009
Messages
1,942
Office Version
  1. 2019
  2. 2016
Platform
  1. Windows
Haha. Yep. Just the 1 little line.

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

Dave
 

Forum statistics

Threads
1,148,371
Messages
5,746,305
Members
424,006
Latest member
Metal_warrior

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top