Help with VBA to send email to several recipients listed in different columsn

[mgrass1142]

I want to use VBA so that I can send the same email to all recipients within an excel row, and have it go through several rows. So if I have Column A, B and C with email recipients I want the recipients in A1, B1 and C1 to get one email referring to them, and A2, B2, C2 to get a different email (same body but changing the names). I am thinking the body of each email to be something like "Dear "A1", you've been assigned "B1" and "C1" to work with you", having A1's email address in the To" field and B1,C1 CC'd, and have the macros do that for all rows. Can anyone help me with this?

[Logit]

.
The goto resource for VBA Email : https://www.rondebruin.nl/win/s1/outlook/mail.htm

[mgrass1142]

Thanks Logit! The issue is that the code proposed there is one where You send a separate email to each of the recipients listed in one column (i.e one recipient per email). I need sub-groups of recipients, meaning for each row, all recipients listed across a row get the same email but its different from the email that others row get in that it names the people associated to the emails. Any idea how to adjust Rondebruins examples to that end?

[Logit]

.
You can list as many email addresses as you want in your project, separated by a comma (or is it a semi-colon?). Works just like Outlook when you want to send the same message to several different folks.

[Charlize]

A bit adapted version. A1 is the to and B1 and C1 are the cc parts.

Sub Test1()'For Tips see: http://www.rondebruin.nl/win/winmail/Outlook/tips.htm
'Working in Office 2000-2016
    Dim OutApp As Object
    Dim OutMail As Object
    Dim cell As Range


    Application.ScreenUpdating = False
    Set OutApp = CreateObject("Outlook.Application")


    On Error GoTo cleanup
    For Each cell In Columns("A").Cells.SpecialCells(xlCellTypeConstants)
        If cell.Value Like "?*@?*.?*" Then
            Set OutMail = OutApp.CreateItem(0)
            On Error Resume Next
            With OutMail
                .To = cell.Value
                .cc = cell.Offset(0, 1).Value & ";" & cell.Offset(0, 2).Value
                .Subject = "Work Assignments"
                '"Dear "A1", you've been assigned "B1" and "C1" to work with you"
                .Body = "Dear " & Split(cell.Value, "@")(0) & ", you've been assigned " & vbCrLf & _
                        Split(cell.Offset(0, 1).Value, "@")(0) & " and " & _
                        Split(cell.Offset(0, 2).Value, "@")(0) & vbCrLf & _
                        " to work with you."
                'You can add files also like this
                '.Attachments.Add ("C:\test.txt")
                '.Send  'Or use Display
                .display
            End With
            On Error GoTo 0
            Set OutMail = Nothing
        End If
    Next cell


cleanup:
    Set OutApp = Nothing
    Application.ScreenUpdating = True
End Sub

Charlize