Combine data in each column from separate cells to one cell

[sncb]

Hi.

I have a spreadsheet with less than 10 columns of data of but each column having varying amount of rows with the data in each column being unique.

I need to combine data in each column from their separate rows into one cell. I have tried:

A. The clipboard copy/paste function
B: Copy into Notepad and re-paste

but thats way too much effort as there are hundreds of such data sets that I need to work on. Any help is appreciated. Thank you.

Original:

Expected results:

 

[Joe4]

Assuming that your data starts in row 2, and you want the combined entry to be in row 1, this VBA code will do the first 10 columns:

Sub MyCombine()

    Dim c As Long
    Dim lr As Long
    Dim r As Long
    Dim str As String
   
    Application.ScreenUpdating = False
   
'   Loop through first 10 columns
    For c = 1 To 10
'       Find last row in column with data
        lr = Cells(Rows.Count, c).End(xlUp).Row
'       Proceed if any entries in column
        If lr > 1 Then
'           Loop through all rows of data, starting in row 2
            For r = 2 To lr
                If r = 2 Then
                    str = Cells(r, c)
                Else
                    str = str & vbCrLf & Cells(r, c)
                End If
            Next r
        End If
'       Insert entry into row 1
        Cells(1, c) = str
    Next c
   
    Application.ScreenUpdating = True
   
    MsgBox "Macro complete!"
   
End Sub

 

[sncb]

Thanks Joe, Works brilliantly. Also great that you mentioned what each part of the code does. Helps a lot to learn about the thought process.

The prior step however that I do to ensure that my data set in each column does not have duplicates, is that I use the Unique function for the 10 columns but the end result of Unique ends up adding a 0 at the bottom of the last row in each column. So I manually go to the end of each column, delete that 0 and then run the VBA code.

Could it be adapted to remove duplicates first?

 

[Rick Rothstein]

Assuming the same setup as Joe, this more compact macro should also work...

Sub RowsToOneCellByColumns()
  Dim Col As Range
  For Each Col In Range("A1", Cells(2, Columns.Count).End(xlToLeft)).EntireColumn
    Cells(1, Col.Column) = Join(Application.Transpose(Range(Cells(2, Col.Column), Cells(Rows.Count, Col.Column).End(xlUp))), vbLf)
  Next
End Sub

 

[Joe4]

Try this version to first remove duplicates:

Sub MyCombine2()

    Dim c As Long
    Dim lr As Long
    Dim r As Long
    Dim str As String
   
    Application.ScreenUpdating = False
   
'   Loop through first 10 columns
    For c = 1 To 10
'       Initialize string
        str = ""
'       Find last row in column with data
        lr = Cells(Rows.Count, c).End(xlUp).Row
'       Remove duplicates
        ActiveSheet.Range(Cells(2, c), Cells(lr, c)).RemoveDuplicates Columns:=1, Header:=xlNo
'       Proceed if any entries in column
        If lr > 1 Then
'           Loop through all rows of data, starting in row 2
            For r = 2 To Cells(Rows.Count, c).End(xlUp).Row
                If r = 2 Then
                    str = Cells(r, c)
                Else
                    str = str & vbCrLf & Cells(r, c)
                End If
            Next r
        End If
'       Insert entry into row 1
        Cells(1, c) = str
    Next c
   
    Application.ScreenUpdating = True
   
    MsgBox "Macro complete!"
   
End Sub

Also note that there was a slight error in my original code that I needed to fix.
I had to remove the quotes around the c here:

        lr = Cells(Rows.Count, "c").End(xlUp).Row

so that it looks like this:

        lr = Cells(Rows.Count, c).End(xlUp).Row

 

[sncb]

Thank you Joe. Works absolutely as expected. Made my day.

Thanks Rick for your input as well. I did get a debugging error when I ran your code but as Joe's code works fine, but Thanks anyway.

 

[Joe4]

You are welcome.
Glad we were able to help!

 

[Rick Rothstein]

Thanks Rick for your input as well. I did get a debugging error when I ran your code but as Joe's code works fine, but Thanks anyway.

The code I posted worked perfectly for me when I tested it, so I have a couple of questions...

1) What was the error number and error description?

2) What line of code was highlighted when the error occurred?

.

 

[sncb]

Hi Rick,

My sincere apologies. I saw your message only just now.

When I re-ran your code to get the error just now, it didnt show up again. I tried with more data and it still works so looks like it works perfectly.

Thank you again for your help.

Kind Regards