# How to combine values from multiple rows into a single row using module?

I'm looking to combine multiple rows into a single row based on a value in the code column.. I've noticed other questions on here similiar to my question but I cannot seem to extend the range..

``````Code    Name    Value A Value B Value C Value D Value E
101   Example      #
101   Example
101   Example                     #
101   Example                            #
101   Example                                    #
102   Example2                                   #
102   Example2                           #
102   Example2                    #
102   Example2            #
102   Example2     #
``````

So the final result looks like this:

``````Code    Name    Value A Value B Value C Value D Value E
101    Example     #               #       #       #
102    Example2    #       #       #       #       #
``````

Edit

This is what I've got so far, my plan was to shift the items to the row above before deleting the entire row as one row may have many items.

``````Dim RowNum, LastRow, Col As Long

RowNum = 2
Col = 3

LastRow = Cells.SpecialCells(xlCellTypeLastCell).row
Range("A2", Cells(LastRow, 7)).Select

For Each row In Selection
With Cells
If Cells(RowNum, 1) = Cells(RowNum + 1, 1) Then
For Each Cell In row
If Cell > 0 Then
Cells(RowNum + 1, Col).Copy Destination:=Cells(RowNum, Col)
Else
Col = Col + 1
End If
Rows(RowNum + 1).EntireRow.Delete
End If
End With

RowNum = RowNum + 1

Next row
``````
• this solution will work. Start with it and see where you go wrong, then post what you have and we can help you where you're stuck. – Raystafarian Jan 30 '14 at 12:44
• The solution works but with one issue, I'm not able to increment the ColumnIndex value with each loop: For Each Row In Selection With Cells If Cells(RowNum, 1) = Cells(RowNum + 1, 1) Then Cells(RowNum + 1, Col).Copy Destination:=Cells(RowNum, Col) 'Rows(RowNum + 1).EntireRow.Delete Col = Col + 1 End If End With – damm Jan 30 '14 at 14:12
• Work with the cells(RowNum, 1) - the "1" is the column number (A=1, B=2) and just copy what is happening. Like I said, write it up and post your code in your question and we'll be happy to troubleshoot it. – Raystafarian Jan 30 '14 at 14:26
• Since there can be multiple items per row, will there ever be multiple items for matching rows in the same column? – Raystafarian Jan 30 '14 at 18:18
• Apologies for the late reply,.Yes, there could be multiple items for matching rows in the same column – damm Jan 31 '14 at 9:24

I'm kind of ashamed of the answer you based your code on. Backup your data and test on a copy!

This should work:

``````Sub combine()

Dim c As Range
Dim i As Integer

For Each c In Range("A2", Cells(Cells.SpecialCells(xlCellTypeLastCell).Row, 1))
If c = c.Offset(1) And c <> "" Then
For i = 1 To 6
If c.Offset(1, i) <> "" Then
c.Offset(, i) = c.Offset(1, i)
End If
Next
c.Offset(1).EntireRow.Delete
End If

Next

End Sub
``````
• Thanks, this works a treat! Would this work with .PasteSpecial(xlPasteFormats) ? – damm Feb 3 '14 at 11:01
• You'd need to modify it to copy/paste or to bring cell format via VBA, so no, not inherently. – Raystafarian Feb 3 '14 at 13:45