VBA Code To Email Multiple Recipients From Excel

[cdurfey]

I am writing a code to send an email from excel using the name in column AR. I have the following code but it will only pull the 1st name it comes to. I need it to pull all of the names. There will be some names that are repeated so I would like for it to pull each name only once if that is possible. Thanks

Dim OutApp As Object
    Dim OutMail As Object
    Dim Recipients As String, c As Range
    Set r = Range("AR2")
    For Each c In r

            Recipients = ";" & c.Value
    Next c
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    On Error Resume Next

[Rick Rothstein]

I am writing a code to send an email from excel using the name in column AR. I have the following code but it will only pull the 1st name it comes to. I need it to pull all of the names. There will be some names that are repeated so I would like for it to pull each name only once if that is possible. Thanks

Dim OutApp As Object
Dim OutMail As Object
Dim Recipients As String, c As Range
Set r = Range("AR2")
For Each c In r

Recipients = ";" & c.Value
Next c
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next

Try replacing the line of code I highlighted in red above with this...

If InStr(Recipients & ";", ";" & c.Value & ";") = 0 Then Recipients = Recipients & ";" & c.Value

Note: After the loop has finished, the Recipients variable will start with a semi-colon... you can remove it by placing this line of code after the Next statement...

Recipients = Mid(Recipients, 2)

[cdurfey]

I am still getting just the 1st person in the list.

[Rick Rothstein]

I am still getting just the 1st person in the list.

Duh, well of course you are getting just the first name... I just re-looked at your code...

Dim OutApp As Object
    Dim OutMail As Object
    Dim Recipients As String, c As Range
    Set r = Range("AR2")
    For Each c In r

            Recipients = ";" & c.Value
    Next c
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    On Error Resume Next

I highlighted the problem in red above... your For..Each loop is iterating through all the cell is range 'r'... there is only one cell in range 'r'. You need to expand the range to include all the cells you want processed. Assuming the your names are in column AR, your code for that Set line should probably look like this...

Set r = Range("AR2:AR" & Cells(Rows.Count, "AR").End(xlUp).Row)

Note: You will still have to make the change to the line of code inside the For..Next block that I posted earlier in order to get all the names in the list.

[cdurfey]

I must be sleeping. Thanks for the help.