Merge email address list

[ozwebsh]

Hi

I have an excel sheet with multiple columns

In one column I have a bunch of email addresses (and another with phone numbers) say Column G.

Example
a@a.com
b@b.com
c@c.com

I need to be able to select the cells with the data (part of column G), run a macro, and have it output in the following format to a predetermined cell ie E1

a@a.com;b@b.com;c@c.com

With phone numbers, will need to do the same thing but use a "," instead of ";"

I've tried varients of code I have found but really don't understand VB enough to make them do what I want

Cheers
Paul

[ragulduy]

There are a few UDF's for doing this sort of thing available. One is below. Then type something like =Range2Csv(G5:G14,";") in E1, where G5:G14 is the cells you want to apply it to and ; is the delimiter you want.

Option Explicit
'**********************************************
'* PURPOSE: Concatenates range contents into a
'*          delimited text string
'*
'* FUNCTION SIGNATURE: Range2Csv(Range, String)
'*
'* PARAMETERS:
'*    Range  - the range of cells whose contents
'*             will be included in the CSV result
'*    String - delimiter used to separate values
'*             (Optional, defaults to a comma)
'*
'* AUTHOR: www.dullsharpness.com
'*
'* NOTES: [add'l notes removed for brevity]
'*
'**********************************************
Public Function Range2Csv(inputRange As Range, Optional delimiter As String)
  Dim concattedList As String 'holder for the concatted CSVs
  Dim rangeCell As Range      'holder cell used in For-Each loop
  Dim rangeText As String     'holder for rangeCell's text

  'default to a comma delimiter if none is provided
  If delimiter = "" Then delimiter = ","

  concattedList = ""          'start with an empty string

  'Loop through each cell in the range to append valid contents
  For Each rangeCell In inputRange.Cells

    rangeText = rangeCell.Value 'capture the working value

    'Only operate on non-blank cells (i.e. Length > 0)
    If Len(rangeText) > 0 Then
      'Strip any delimiters contained w/in the value itself
      rangeText = WorksheetFunction.Substitute(rangeText, delimiter, "")

      If (Len(concattedList) > 0) Then
        'prepend a delimiter to the new value if we
        'already have some list items
        concattedList = concattedList + delimiter + rangeText
      Else
        'else if the list is blank so far,
        'just set the first value
        concattedList = rangeText
      End If
    End If

  Next rangeCell

  'Set the return value
  Range2Csv = concattedList

End Function

[ozwebsh]

Hi ragulduy

That actually makes sense! Thanks

However on using it in my sheet, excel seems to recognise Range2Csv as a function but I get a #NAME? error when I use it in the format you specified (with or without a delimiter)

[ragulduy]

Where have you put the code? It should be in a separate module.

Can you upload your worksheet?

[ozwebsh]

Hi Ragulduy

Seems it musnt have saved properly or something - its all good now!

Works just as I was after - thanks for your help, much appreciated.

Cheers
Paul

[JOHN H. DAVIS]

Assumes the email addresses are in Column F and places them in E1.
Assumes the phone numbers are in Column G and places them in D1.

Sub ozwebsh()
Dim i As Long
Dim z As String
Dim w As String
Dim x As String
Dim y As String
y = ""
z = ""
    For i = 2 To Range("G" & Rows.count).End(3).Row
        x = Cells(i, "F").Text
        w = Cells(i, "G").Text
        y = y & x & "; "
        z = z & w & ", "
        y = y
        z = z
    Next i
Range("E1") = y
Range("D1") = z
Range("E1") = Left([E1], Len([E1]) - 2)
Range("D1") = Left([D1], Len([D1]) - 2)


End Sub