Take the 2-minute tour ×
Super User is a question and answer site for computer enthusiasts and power users. It's 100% free, no registration required.

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

1 Answer 1

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. –  Ellesa Jun 25 '12 at 19:35

Your Answer

 
discard

By posting your answer, you agree to the privacy policy and terms of service.

Not the answer you're looking for? Browse other questions tagged or ask your own question.