Excel VBA send to email address by looking for header match and sending email to first cell beneath matching header

fbatson

New Member
Joined
May 24, 2021
Messages
3
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
I'm looking send to specific email addresses by looking for header "Fund Email" and then sending email to first cell beneath matching header. the email address column is not always the same which is why i need it to return the cell beneath (which is where the email address is, eg email header ak1-email address ak2) once it matches.

[Excel file example][1] [1]:
I want to replace range AJ2 in my code with something that can lookup the header (row 1) and insert the email address that corresponds (single cell, row 2). Because like I said above the column might not always be AJ, but the header will always be "fund email".

ActiveWorkbook.SaveAs
"\\na\Forrest\Backup.xlsx"
Dim OutApp As Object
Dim OutMail As Object
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

On Error Resume Next
With OutMail
.To = Range("AJ2").Value
.CC = ""
.BCC = ""
.Subject = Range("AK2").Value + " -Benefits backup"
.Body = "Attached is the current month's benefit payment backup for
check en route to your fund's office."
.Attachments.Add ActiveWorkbook.FullName
.send
End With
On Error GoTo 0

Set OutMail = Nothing
Set OutApp = Nothing

ActiveWorkbook.Close


Thanks!
 

Attachments

  • Capture.JPG
    Capture.JPG
    46.2 KB · Views: 5

Excel Facts

Which came first: VisiCalc or Lotus 1-2-3?
Dan Bricklin and Bob Frankston debuted VisiCalc in 1979 as a Visible Calculator. Lotus 1-2-3 debuted in the early 1980's, from Mitch Kapor.

mrshl9898

Well-known Member
Joined
Feb 6, 2012
Messages
1,951
Added a loop to find the column.

VBA Code:
ActiveWorkbook.SaveAs
"\\na\Forrest\Backup.xlsx"
Dim OutApp As Object
Dim OutMail As Object
Dim colnum As Long
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
colnum = 1

Do Until Cells(1, colnum) = "Fund Email"
    colnum = colnum + 1
    If colnum > 300 Then
        MsgBox "Column not found"
        Exit Sub
    End If
Loop

On Error Resume Next
With OutMail
.To = Cells(2, colnum).Value
.CC = ""
.BCC = ""
.Subject = Cells(2, colnum + 1).Value+ " -Benefits backup"
.Body = "Attached is the current month's benefit payment backup for"
check en route to your fund's office."
.Attachments.Add ActiveWorkbook.FullName
.send
End With
On Error GoTo 0

Set OutMail = Nothing
Set OutApp = Nothing

ActiveWorkbook.Close
 
Solution

fbatson

New Member
Joined
May 24, 2021
Messages
3
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
Added a loop to find the column.

VBA Code:
ActiveWorkbook.SaveAs
"\\na\Forrest\Backup.xlsx"
Dim OutApp As Object
Dim OutMail As Object
Dim colnum As Long
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
colnum = 1

Do Until Cells(1, colnum) = "Fund Email"
    colnum = colnum + 1
    If colnum > 300 Then
        MsgBox "Column not found"
        Exit Sub
    End If
Loop

On Error Resume Next
With OutMail
.To = Cells(2, colnum).Value
.CC = ""
.BCC = ""
.Subject = Cells(2, colnum + 1).Value+ " -Benefits backup"
.Body = "Attached is the current month's benefit payment backup for"
check en route to your fund's office."
.Attachments.Add ActiveWorkbook.FullName
.send
End With
On Error GoTo 0

Set OutMail = Nothing
Set OutApp = Nothing

ActiveWorkbook.Close
Thank you so much that worked flawlessly! Do you know how I could essentially do the same thing with subject line and the header "CBA" (the column next to "fund email")?
 

fbatson

New Member
Joined
May 24, 2021
Messages
3
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
Added a loop to find the column.

VBA Code:
ActiveWorkbook.SaveAs
"\\na\Forrest\Backup.xlsx"
Dim OutApp As Object
Dim OutMail As Object
Dim colnum As Long
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
colnum = 1

Do Until Cells(1, colnum) = "Fund Email"
    colnum = colnum + 1
    If colnum > 300 Then
        MsgBox "Column not found"
        Exit Sub
    End If
Loop

On Error Resume Next
With OutMail
.To = Cells(2, colnum).Value
.CC = ""
.BCC = ""
.Subject = Cells(2, colnum + 1).Value+ " -Benefits backup"
.Body = "Attached is the current month's benefit payment backup for"
check en route to your fund's office."
.Attachments.Add ActiveWorkbook.FullName
.send
End With
On Error GoTo 0

Set OutMail = Nothing
Set OutApp = Nothing

ActiveWorkbook.Close
oh wait i just realized your code does that already, thank you!
 

Forum statistics

Threads
1,136,862
Messages
5,678,195
Members
419,750
Latest member
crp

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