Format multiple columns of emails into one column

S

snuffnchess

Board Regular
Joined
May 15, 2015
Messages
71
Office Version
  1. 365
Platform
  1. Windows
I have a list of email addresses that exist is columns C through H that belong to a company listed in A and am needing to essentially combine those emails into one variable so that when an email is created, it sends to to everybody.

Because there are different numbers of columns filled with data, and we cannot have extra ";" if there are blanks, how does this get coded?

Here is what the email data looks like in current format, and the format it is needing to be in
email.xlsx
ABCDEFGHIJKL
1GivenNeeded
2NameTeamEmail 1Email 2Email 3Email 4Email 5Email 6NameTeam
3Company 1Team 3c11firstlast@email.comc12firstlast@email.comc13firstlast@email.comCompany 1Team 3c11firstlast@email.com; c12firstlast@email.com; c13firstlast@email.com
4Company 2Team 1c21firstlast@email.comc22firstlast@email.comCompany 2Team 1c21firstlast@email.com; c22firstlast@email.com
5Company 3Team Tc31firstlast@email.comc32firstlast@email.comc33firstlast@email.comc34firstlast@email.comc35firstlast@email.comCompany 3Team Tc31firstlast@email.com; c32firstlast@email.com; c33firstlast@email.com; c34firstlast@email.com; c35firstlast@email.com
6Company 4Team Tc41firstlast@email.comc42firstlast@email.comc43firstlast@email.comc44firstlast@email.comc45firstlast@email.comCompany 4Team Tc41firstlast@email.com; c42firstlast@email.com; c43firstlast@email.com; c44firstlast@email.com; c45firstlast@email.com
7Company 5Team 1c51firstlast@email.comc52firstlast@email.comc53firstlast@email.comc54firstlast@email.comc55firstlast@email.comCompany 5Team 1c51firstlast@email.com; c52firstlast@email.com; c53firstlast@email.com; c54firstlast@email.com; c55firstlast@email.com
8Company 6Team Tc61firstlast@email.comc62firstlast@email.comCompany 6Team Tc61firstlast@email.com; c62firstlast@email.com
9Company 7Team 2c71firstlast@email.comCompany 7Team 2c71firstlast@email.com
10Company 8Team 3c81firstlast@email.comCompany 8Team 3c81firstlast@email.com
11Company 9Team 2c91firstlast@email.comCompany 9Team 2c91firstlast@email.com
12
13
Sheet1


Current code to email data

Code: 
Option Explicit
Public sfolder As String
Public sfile As String


Sub SendMail()
    Dim objOutlook As Object
    Dim objMail As Object

    Dim emTo As String
    Dim emRep As String
    Dim emSubject As String
    Dim emBody As String
    Dim emAttach As String
    
    Dim emdata As Worksheet
    Dim ob As Workbook
    
    Set ob = ThisWorkbook
    Set emdata = ob.Sheets("Email")
    
    emBody = "<p><b>Hello</b></p>" & "<p>Here is your file</p>" & "<p> Do not ask us any questions</p>"
    
    sfolder = emdata.Range("I1").Value

    Set objOutlook = CreateObject("Outlook.Application")

    Dim r As Long: For r = 2 To ActiveSheet.Range("A2").End(xlDown).Row
        With ActiveSheet
            emTo = .Range("C" & r).Value
            emRep = .Range("B" & r).Value
            emSubject = .Range("A" & r).Value & " - Report - " & Format(Now, "yyyy-mm-dd")
            sfile = emdata.Range("A" & r).Value & ".xlsx"
            emAttach = sfolder & "\" & sfile
        End With

        Set objMail = objOutlook.CreateItem(0)
        With objMail
            .To = emTo
            .ReplyRecipients.Add emRep
            .Subject = emSubject
            .HTMLBody = "<html><head></head><body>" & em & "</body></html>"
            .Attachments.Add emAttach
            .Display
            .Send 
        End With
    Next
End Sub
 

Excel Facts

How to total the visible cells?
From the first blank cell below a filtered data set, press Alt+=. Instead of SUM, you will get SUBTOTAL(9,)
Sort by date Sort by votes
An alternative solution is with Power Query

Power Query: 
let
    Source = Excel.CurrentWorkbook(){[Name="Table1"]}[Content],
    #"Replaced Value" = Table.ReplaceValue(Source,null,"",Replacer.ReplaceValue,{"Name"}),
    #"Merged Columns" = Table.CombineColumns(Table.TransformColumnTypes(#"Replaced Value", {{"Email 6", type text}}, "en-US"),{"Email 1", "Email 2", "Email 3", "Email 4", "Email 5", "Email 6"},Combiner.CombineTextByDelimiter(",", QuoteStyle.None),"Merged"),
    #"Replaced Value1" = Table.ReplaceValue(#"Merged Columns",",,","",Replacer.ReplaceText,{"Merged"})
in
    #"Replaced Value1"
 
Upvote 0
If you have 365, you could use the
Excel Formula: 
WorksheetFunction.TextJoin
Function to achieve what you want. Try running the following sub as a stand-alone & you'll see what I mean. The True option means it ignores empty cells when concatenating the values. If it does what you want, simply incorporate the method into your existing code.

VBA Code: 
Option Explicit
Sub addEmails()
    Dim r As Long, rng As Range, emTo As String
    Dim ws As Worksheet: Set ws = ActiveSheet
  
    For r = 3 To ActiveSheet.Range("A2").End(xlDown).Row
        Set rng = ws.Range(ws.Cells(r, 3), ws.Cells(r, 8))
        emTo = WorksheetFunction.TextJoin(";", True, rng)
        MsgBox emTo
    Next r
End Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

S
  • Question Question
Sending Attachments via Outlook - VBA if attachment file does not exist
Replies
1
Views
3K
snuffnchess
S
S
  • Question Question
If no email address then skip row and move on to next
Replies
2
Views
1K
snuffnchess
S
M
  • Question Question
Send email with rows based on expiration date
2
Replies
10
Views
1K
Musto85
M
willow1985
  • Solved
VBA Compile error - Trying to send an email using VBA/Excel
Replies
6
Views
1K
gorgkhan
G
G
  • Question Question
Adding signature to for loop email creaton
Replies
1
Views
472
breynolds0431
B

Forum statistics

Threads
1,224,530
Messages
6,179,373
Members
452,907
Latest member
Roland Deschain

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top