How can I create emails for only unique addresses from a column in excel?

Question

Currently, I'm trying to create blast emails to be sent to customers, and there are some duplicate email addresses in the column list. I want to only send one email to each unique email address, but when I run my macro it creates an email for each cell in the column, regardless if there's a repetition of the address earlier/later in the column. a snippet of my code is below:

With Application
    .EnableEvents = False
    .ScreenUpdating = False
End With

    Set sh = Sheets("TestSheet")

    Set OutApp = CreateObject("Outlook.Application")    

For Each cell In sh.Columns("D").Cells.SpecialCells(xlCellTypeConstants)

    Set rng = sh.Cells(cell.Row, 1).Range("E1:Z1")

        If cell.Value Like "?*@?*.?*" And _
            Application.WorksheetFunction.CountA(rng) > 0 Then

                Set OutMail = OutApp.CreateItem(0)
                Set Entity = cell.Offset(0, -3)
                Set Quarter = cell.Offset(0, -2)
                Set Year = cell.Offset(0, -1)
                Set CCRecip = cell.Offset(0, 1)

                    strbody = "<font face = 'Calibri'><b>Hello All--</b>" & ...

                    signature = "<br>Thank you,<br>" & ...

                        .To = cell.Value
                        .CC = CCRecip.Value
                        .Subject = Entity.Value 
                        .HTMLBody = strbody & signature             
                        .display
                    End With                  
                Set OutMail = Nothing

        End If

Next cell

store the email addresses in a collection and check the collection to see if it's in there before creating an email. If it is, skip. — OpiesDad, Apr 13 '16 at 18:33
The file I use is created from a system report and changes all the time. It's related to Over Due invoices so a customer could have multiple rows on this spreadsheet. There's over 3000 rows of records, and multiple new email addresses could be added each time it's ran (as well as others be removed). So creating and maintaining an address collection could in turn be tedious. — SamHink123, Apr 13 '16 at 18:38
You don't maintain it. You use a "Collection" object in the code. I'll add an answer. — OpiesDad, Apr 13 '16 at 18:43
Why not "Remove Duplicates" from your email list first? Then just run the code. (Or, duplicate the Email column, then remove duplicates, if you want to keep the original list too). Or, why not check all the cells ABOVE the current cell, and if there's a `like` or match, then skip the current row? — BruceWayne, Apr 13 '16 at 18:45

score 0 · Answer 1 · edited May 23 '17 at 12:16

 Dim myColl As Collection
 Set myColl = New Collection

 With Application
     .EnableEvents = False
     .ScreenUpdating = False
 End With

 Set sh = Sheets("TestSheet")

 Set OutApp = CreateObject("Outlook.Application")    

 For Each cell In sh.Columns("D").Cells.SpecialCells(xlCellTypeConstants)

     Set rng = sh.Cells(cell.Row, 1).Range("E1:Z1")

     If cell.Value Like "?*@?*.?*" And _
        Application.WorksheetFunction.CountA(rng) > 0 Then
         If Not Contains(myColl, CStr(cell.Value)) Then
                 myColl.Add CStr(cell.Value), CStr(cell.Value)
                 Set OutMail = OutApp.CreateItem(0)
                 Set Entity = cell.Offset(0, -3)
                 Set Quarter = cell.Offset(0, -2)
                 Set Year = cell.Offset(0, -1)
                 Set CCRecip = cell.Offset(0, 1)

                 strbody = "<font face = 'Calibri'><b>Hello All--</b>" & ...

                 signature = "<br>Thank you,<br>" & ...

                    .To = cell.Value
                    .CC = CCRecip.Value
                    .Subject = Entity.Value 
                    .HTMLBody = strbody & signature             
                    .display
                End With                  
                Set OutMail = Nothing

         End If
    End If

 Next cell

 End Sub

 Public Function Contains(col As Collection, key As Variant) As Boolean
     Dim obj As Variant
     On Error GoTo err
     Contains = True
     obj = col(key)
     Exit Function
 err:

     Contains = False
 End Function

Contains function courtesy of Vadim here

When I added this to my code, I start getting a Compile error on the "Next cell" line saying "Next without For." Any idea's on what would be causing this? — SamHink123, Apr 15 '16 at 15:50
Yeah. There's an extraneous "End With" in the middle of your code under ".display" I left it as it was, but I'm guessing if you remove it, the code should compile. — OpiesDad, Apr 15 '16 at 19:28

How can I create emails for only unique addresses from a column in excel?

1 Answers1