Aggregate numbers in Column A in one cell, separated by commas

Andreas Hermle
Andreas Hermle used Ask the Experts™
on
Dear Experts,

I got hundreds of numbers in Column A (starting in A2) which I would like to aggregate (by means of a macro) in one cell in B2, separated by commas.

Example

Column A                 Column B
Column Header
90-234-55-77          90-234-55-77,90-445-22-99,90-343-11-45,90-343-12-99,90-574-13-21,90-537-19-43,etc.
90-445-22-99
90-343-11-45
90-343-12-99
90-574-13-21
90-537-19-43
etc.

Help is much appreciated. Thank you very much in advance.

Regards, Andreas
Comment
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
Group Finance Manager
Commented:
Try this

Option Explicit

Sub x()
    Dim rCl As Range
    Dim iX As Integer
    With ActiveSheet
        .Cells(1, 2).ClearContents
        For Each rCl In Range(Cells(1, 1), Cells(Rows.Count, 1).End(xlUp))
            .Cells(1, 2).Value = .Cells(1, 2).Value & "," & rCl.Value
        Next rCl
        iX = Len(.Cells(1, 2).Value) - 1
        .Cells(1, 2).Value = Right(.Cells(1, 2).Value, iX - 1)
    End With

End Sub

Open in new window

ShumsManaging Director/Excel VBA Developer
Distinguished Expert 2018
Commented:
Hi Andreas,

Please try below:
Sub CombineRange()
Dim Ws As Worksheet
Dim LastR As Long
Dim Rng As Range
Dim InputRng As Range, OutRng As Range
Set Ws = ActiveSheet
LastR = Ws.Range("A" & Rows.Count).End(xlUp).Row
Set InputRng = Ws.Range("A2:A" & LastR)
Set OutRng = Ws.Range("B2")
Application.ScreenUpdating = False
OutStr = ""
For Each Rng In InputRng
    If OutStr = "" Then
        OutStr = Rng.Value
    Else
        OutStr = OutStr & ", " & Rng.Value
    End If
Next
OutRng.Value = OutStr
Application.ScreenUpdating = True
End Sub

Open in new window

Roy CoxGroup Finance Manager

Commented:
Just a slight amendment

Option Explicit

Sub x()
    Dim rCl As Range
    Dim iX As Integer
    With ActiveSheet
        .Cells(1, 2).ClearContents
        For Each rCl In Range(Cells(1, 1), Cells(Rows.Count, 1).End(xlUp))
            .Cells(1, 2).Value = .Cells(1, 2).Value & "," & Trim(rCl.Value)
        Next rCl
        iX = Len(.Cells(1, 2).Value)
        .Cells(1, 2).Value = Right(.Cells(1, 2).Value, iX - 1)
    End With

End Sub

Open in new window

Andreas HermleTeam leader

Author

Commented:
Dear both,

both solutions work just fine, a superb job from both of you. I really appreciate it. Since Roy was the first to answer the majority of the points go to his account.

Again, thank you very much and have a nice Sunday.

Regards, Andreas
Roy CoxGroup Finance Manager

Commented:
Pleased to help

Do more with

Expert Office
Submit tech questions to Ask the Experts™ at any time to receive solutions, advice, and new ideas from leading industry professionals.

Start 7-Day Free Trial