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
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