Copy row and paste to right of last column

Question

I have about 5,000 lines of data. Each line has data in about 20 columns with an ID number. Some ID numbers repeat on some lines because they are related. I need to put data from lines with the same ID numbers into a single line on another sheet.

Have:

ID    Date      Data1  Data2  Data3   Data4
3     4/1/2012    6      12    9        7
3     4/2/2012    5      11    6        1
26    5/12/2014   3       9    5        4

Need:

       Date      Data1  Data2  Data3  Data4  Date     Data1  Data2  Data3  Data4
3     4/1/2012    6      12    9        7    4/2/2012    5      11    6        1  
26    5/12/2014   3       9    5        4

There are many more columns in each line so is it possible for each paste to look for the first available blank column?

Answer 1

Welcome to SO/SE! Have you tried any solutions to this as yet? Please update the OP with a description if so. Try the below steps and hopefully they'll work for you. I've formatted the below as a datatable using ctrl + t but you can convert the formulas to R1C1 if you prefer

Step 1: add 3 helper columns

+----+-----------+-------+-------+-------+-------+---------+--------+---------------+
| ID |   Date    | Data1 | Data2 | Data3 | Data4 | IdCount | RowNum | NextRowSameId |
+----+-----------+-------+-------+-------+-------+---------+--------+---------------+
|  3 | 5/12/2016 |     3 |     4 |     5 |       |       3 |      3 |             3 |
|  3 | 4/1/2012  |     6 |    12 |     9 |     7 |       3 |      4 |               |
| 26 | 5/12/2014 |     3 |     9 |     5 |     4 |       1 |      5 |               |
+----+-----------+-------+-------+-------+-------+---------+--------+---------------+

1. for IdCount, use =COUNTIFS([ID],[@ID])
2. for RowNum, use =ROW()
3. for NextRowSameId, use =IF([@IdCount]>1,IFERROR(AGGREGATE(15,6,[RowNum]/(([RowNum]>[@RowNum])*([ID]=[@ID])),1),""),"")

Then press alt + f11 to open the VBA editor, insert a module, and enter the following code

Sub sanitize()
    Dim NextRow As Range, RngTxt As String, NextRowNum As Integer
    For Each c In Range("data[IdCount]")
ResetInnerLoop:
        If c.Value > 1 Then
            NextRowNum = c.Offset(0, 2).Value
            RngTxt = "A" & CStr(NextRowNum) & ":F" & CStr(NextRowNum)
            Range(RngTxt).Cut
            c.Offset(0, 0).Select
            ActiveCell.End(xlToRight).Select
            ActiveSheet.Paste
            Application.CutCopyMode = False
            Calculate
            If c.Value > 1 Then GoTo ResetInnerLoop
        End If
    Next c
    MsgBox "Success"
End Sub

Edit line 7 of the macro ( RngTxt = "A" & CStr(NextRowNum) & ":F" & CStr(NextRowNum) ) to match your specific table ( instead of :F , use the last datacolumn ). This will leave you with some empty rows, but these can easily be removed with a filter & delete.

Please Note

You should make a copy of your workbook before running the macro as you will not be able to undo with a ctrl + z after running the macro. Hope this helps. Please respond with success / failure if so. Good Luck!