# Combine multiple rows into one

I am trying to combine multiple rows of data into one. Column A contains the value on which the groupings will be based -- rows whose Column A values match will be combined into one row. My range extends from column A through X so I need a matching row of data to start in column Y.

Example:

``````╔══════╦═══╦═══╗
║ 1001 ║ A ║ C ║
║ 1001 ║ B ║ D ║
║ 1002 ║ A ║ E ║
║ 1002 ║ B ║ F ║
║ 1002 ║ C ║ G ║
╚══════╩═══╩═══╝
``````

Desired Result:

``````╔══════╦═══╦═══╦═══╦═══╦═══╦═══╗
║ 1001 ║ A ║ C ║ B ║ D ║   ║   ║
║ 1002 ║ A ║ E ║ B ║ F ║ C ║ G ║
╚══════╩═══╩═══╩═══╩═══╩═══╩═══╝
``````

The VBA code I am currently using is not taking the entire contents of the matched row. It is only taking the data in the 2nd column and moving it up.

VBA Code:

``````Sub Mergeitems()

Dim cl As Range
Dim rw As Range

Set rw = ActiveCell

Do While rw <> ""
' for each row in data set
'   find first empty cell on row
Set cl = rw.Offset(0, 1)
Do While cl <> ""
Set cl = cl.Offset(0, 1)
Loop

' if next row needs to be processed...
Do While rw = rw.Offset(1, 0)
cl = rw.Offset(1, 1)       ' move the data
Set cl = cl.Offset(0, 1)   ' update pointer to next blank cell
rw.Offset(1, 0).EntireRow.Delete xlShiftUp   ' delete old data
Loop

' next row
Set rw = rw.Offset(1, 0)
Loop
End Sub
``````
-
Are you asking how to do this on excel? – criziot Jun 22 '12 at 7:50
it seems there is a flaw in your logic... – tumchaaditya Jun 22 '12 at 7:53
Possible duplicate of superuser.com/questions/244507/… – Nima Jun 22 '12 at 9:14
@nima while the answers are very similar, I think it would be fine to leave both questions open, especially because there seem to be some slight differences in the answers – Ivo Flipse Jun 22 '12 at 9:19

I would probably approach your general problem (merging rows) with an entirely different macro but here are the lines you might want to change in your code:

``````cl = rw.Offset(1, 1)       ' move the data
Set cl = cl.Offset(0, 1)   ' update pointer to next blank cell
rw.Offset(1, 0).EntireRow.Delete xlShiftUp   ' delete old data
``````

Try replacing them with this:

``````i = 1
Do While rw.Offset(1, i) <> ""
cl = rw.Offset(1, i)
Set cl = cl.Offset(0, 1)
i = i + 1
Loop
rw.Offset(1, 0).EntireRow.Delete xlShiftUp  'delete old data
``````

Result:

-
I will try that and report back. Thanks for your help. – Jim Jun 22 '12 at 13:13
I replaced the code with the recommendation above but it did not change anything. It produced the same results that I get with the original code. – Jim Jun 25 '12 at 14:06
@jim It shouldn't. As you can see from my screenshot, it produces a different result from yours. Make sure you're replacing the right lines; and that when you run the macro, the active cell is the upper leftmost cell in your data. – Kaze Jun 25 '12 at 19:35