Combine a column into a single cell

[Sam Pickard]

I have a column of data that will vary in length and I'm trying to write a macro to combine it all into one cell. Basically I need to do the equivalent of entering "=A1&A2&A3..." for the entire column. I started by creating an array string variable and have the data in grp() but now I'm stuck trying to figure out some sort of loop to keep adding onto the same cell or something. Thanks a lot

 

[vaskov17]

add this to a module in the file you use:

Function Conc(rng As Range)
    Dim c As Range
    Dim s As String
    
    For Each c In rng
        s = s & c.Text
    Next
    
    Conc = s
End Function

to use it in a cell type:

=conc(A1:A20)

and it will give you the concatenated contents of cells a1 to a20, just change the range to whatever you need

 

[MARK858]

Another option loosely based on some code by Dave Gugg.

Sub test()
    Dim lR As Long
    Dim i As Long
    Dim result As Variant
    lR = Sheet1.Range("A" & Rows.Count).End(xlUp).Row
    For i = 1 To lR
        result = result & Sheet1.Cells(i, 1)
        Range("C1") = result
    Next i
End Sub

 

[circledchicken]

Hi,

One more possible alternative UDF might be:

Function econcat(oRng As Range, del As String) As String
    econcat = Join(Application.Transpose(oRng), del)
End Function

Like with vaskov17's the steps are:

• Press Alt -> F11 to open the VBA editor
• Click Insert -> Module
• Paste the code above in the white space
• Use it in a cell as shown below, changing A10 to the last cell you want and changing the comma to a delimeter of your choice:
  =econcat(A1:A10,",")

 

[Sam Pickard]

Thank you all so much for your help, I haven't used functions like that before so I'm trying to avoid that for now. This is what I came out with and it works great, Thanks again.

    Dim rng As Range
    Dim c As Range
    Dim s As String
    Set rng = Range("F1", Range("F1").End(xlDown))
    For Each c In rng
        s = s & c.Text
    Next
    Range("G1").Formula = s

 

[vaskov17]

FYI in case your data might have blanks, Range("F1").End(xlDown) will stop at the first one it finds

 

[Rick Rothstein]

Thank you all so much for your help, I haven't used functions like that before so I'm trying to avoid that for now. This is what I came out with and it works great, Thanks again.

    Dim rng As Range
    Dim c As Range
    Dim s As String
    Set rng = Range("F1", Range("F1").End(xlDown))
    For Each c In rng
        s = s & c.Text
    Next
    Range("G1").Formula = s

Using the code approach that circledchicken posted (that is the way I would have done it, although I prefer to use WorksheetFunction rather than Application... personal preference), you can replace all the code you posted with this single line of code...

Range("G1").Value = Join(WorksheetFunction.Transpose(Range("F1:F" & Cells(Rows.Count, "F").End(xlUp).Row)), "")