Combining data from column while deleting duplicate rows
The following puts the rearranged data on a
new sheet. That's easier than putting it on
the existing sheet and deleting rows. It
assumes like Group and Family rows are
together, as in your example.
Hth,
Merjet
Sub Macro1()
Dim ws As Worksheet
Dim ws2 As Worksheet
Dim iRow As Integer
Dim iRow2 As Integer
Set ws = Sheets("Sheet1")
Set ws2 = Sheets("Sheet2")
iRow = 2
iRow2 = 1
Do
If ws.Cells(iRow, 1) = ws.Cells(iRow - 1, 1) And _
ws.Cells(iRow, 2) = ws.Cells(iRow - 1, 2) Then
iCol = iCol + 1
ws2.Cells(iRow2, iCol) = ws.Cells(iRow, 3)
Else
iRow2 = iRow2 + 1
ws2.Cells(iRow2, 1) = ws.Cells(iRow, 1)
ws2.Cells(iRow2, 2) = ws.Cells(iRow, 2)
ws2.Cells(iRow2, 3) = ws.Cells(iRow, 3)
iCol = 3
End If
iRow = iRow + 1
Loop Until ws.Cells(iRow, 1) = ""
End Sub
|