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

[fbatson]

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]:

https://imgur.com/dKybj

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!

 

[mrshl9898]

Added a loop to find the column.

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

 

[fbatson]

Added a loop to find the column.

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]

Added a loop to find the column.

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!