Super User is a question and answer site for computer enthusiasts and power users. Join them; it only takes a minute:

Sign up
Here's how it works:
  1. Anybody can ask a question
  2. Anybody can answer
  3. The best answers are voted up and rise to the top

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
share|improve this question
    
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
1  
@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:

enter image description here

share|improve this answer
    
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

You must log in to answer this question.

Not the answer you're looking for? Browse other questions tagged .