Excel VBA to Send Emails to Different People In a Column - excel

Question

I have a report that is generated for me daily that I need to send out to certain admins. The problem is that not every admin is always mentioned, and the admins that are mentioned often appear multiple times. Plus the number of rows I have is always variable.
It generally appears like this:
What I'd like to have happen is for an email to be generated to each admin that is mentioned. What I have so far is this (my company's email addresses are set up as "first.last#email.email"):
Sub Email_Test()
Columns("F:F").Select
Selection.Replace What:=" ", Replacement:=".", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.Display
End With
signature = OMail.body
With OutMail
.To = Range("F2") & "#email.email" & "; " & Range("F3") & "#email.email" & "; " & Range("F4") & "#email.email" & "; " & Range("F5") & "#email.email" & "; " & Range("F6") & "#email.email"
.CC = ""
.BCC = ""
.Subject = "Report"
.HTMLBody = "See attached" & "<br>" & .HTMLBody
.Attachments.Add ActiveWorkbook.FullName
.DeferredDeliveryTime = ""
.Display
End With
On Error GoTo 0
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
Clearly this will not work, but hopefully it illustrates my idea. Is there a way for me to search column F for each unique instance of a name and then add the email extension? I'm sure there's a less convoluted way than what I currently have.
Thank you!

Answer 1

So, first off it's really dangerous to guess email addresses from a list of names.
(Are you sure there are not two Paul Blarts? If so, only one is getting the report. Are you sure there are not two Tony Pajamas? If so is the right one getting the report?)
Anyway, I'll assume you've considered all of this and you get to keep your job if it goes to the wrong Pajamas.
I would use a scripting.dictionary to hold the emails, using the names or email addresses as the key. Then I could test for membership of the dict before adding another:
Not tested but should give you the jist:
Public Sub CreateEmails()
Dim row As Long
Dim email_address As String
Dim email_dict As Object
Set email_dict = CreateObject("Scripting.Dictionary")
Set OutApp = CreateObject("Outlook.Application")
Dim OutMail As Object
row = 2
Do While ThisWorkbook.Sheets("SheetWithNames").Cells(row, 6).Value <> ""
email_address = email_address_from_name(.Cells(row, 6).Value) 'turns a name into an email
If Not email_dict.exists(email_address) Then
Set OutMail = OutApp.CreateItem(0)
With OutMail
.To = email_address
.Subject = "Report"
.HTMLBody = "See attached" & "<br>" & .HTMLBody
.Attachments.Add ActiveWorkbook.FullName
.Display
End With
email_dict.Add email_address, OutMail
End If
row = row + 1
Loop
End Sub