Merging data in cells and seperating by a comma in 1 cell

[haydenmeeks]

Hi there

I have been working and trying everything I can think of and using other examples to try and get this project finished but just can't seem to do it

I have worksheet with up to as many as 200 or 300 phone numbers in row 1. Each cell holds its own phone number. Each time I run this report or macro, the number of phone numbers will vary. Could be 10, could be 100.

What I would like to do is merge them all into 1 cell and seperate each phone number by a comma (no spaces) in the 1 cell, so I can right click and copy the data to another program (batch SMS) easily.
I know there can be a limit of numbers that a cell can hold so if this needs to be spread over a number of different cells thats ok. Provided the last character in a cell is a comma therefore I can do it sequentially, 1 cell after the other and copy and paste into the other program.

Any help with this would be greatly appreciated.

Many thanks guys
Hayden

 

[gallen]

OK, Ricks is infinitely quicker but if you have data that will exceed the cell maximum, this will fill A1, then B1 and so on until all numbers in Column A are added

Sub MergeNumbers()

Dim lr As Long 'last used row
Dim i As Long, j As Integer


    
    lr = Range("A" & Rows.Count).End(xlUp).Row
    'Cells can hold a max of 32767 characters. If we exceed that we need to go to next cell
    j = 1 'Column number of cell
    
    Application.ScreenUpdating = False
    For i = 2 To lr 'start in 2nd Row
        If Len(Cells(i, 1)) > 0 Then
            If Len(Cells(i, 1)) + Len(Cells(1, j)) > 32767 Then
                j = j + 1
                Cells(1, j) = Cells(i, 1)
            Else
                Cells(1, j) = Cells(1, j) & "," & Cells(i, 1)
            End If
        End If


    Next i
    MsgBox "Done", vbInformation
    Application.ScreenUpdating = True
End Sub

 

[pgc01]

Hi Hayden

You forgot to post your excel version and so I don't know what you have available.

With excel 2016, you can use the formula:

=TEXTJOIN(",",TRUE,A1:Z1)