ColumnMatch Include Column H:I

The macro below takes these steps (Joel macro)…

1. Go to Sheet “R1” look at the contents in cell A1 then look for a
duplicate of those contents in Column C and Column E.

2. When Column A has duplicates in Column C and Column E, copy that row of
Column A and include Column B, then copy the matching row in Column C while
including Column D, and finally copy the matching row of column Column E
while including the same row of Column F and Column G. In other words A:B
belong together, C belong together, and E:G belong together, but these
Columns get grouped together based on the contents in Columns A, C, and E.

3. Select worksheet “Final” and paste Columns A:B, Columns C, and Columns
E:G from sheet “R1”, which may have all been in all different rows, into the
same row in sheet “Final”.

Go back to sheet “R1”and repeat the same process for every row in Column A.



Sub ColumnMatch()

Application.ScreenUpdating = False
Newrow = 1
Set ws1 = Sheets("R1")
With ws1
LastRow = .Range("A" & Rows.Count).End(xlUp).Row
For RowCount = 1 To LastRow
A_Data = .Range("A" & RowCount)
B_Data = .Range("B" & RowCount)
FirstNewRow = Newrow
Set c = .Columns("C").Find(what:=A_Data, _
LookIn:=xlValues, lookat:=xlWhole)
If Not c Is Nothing Then
firstAddr = c.Address
Do
C_Data = .Range("C" & c.Row)
D_Data = .Range("D" & c.Row)
With Sheets("Final")
.Range("A" & Newrow) = A_Data
.Range("B" & Newrow) = B_Data
.Range("C" & Newrow) = C_Data
.Range("D" & Newrow) = D_Data
Newrow = Newrow + 1
End With
Set c = .Columns("C").FindNext(after:=c)
Loop While Not c Is Nothing And c.Address <> firstAddr
End If

Set c = .Columns("E").Find(what:=A_Data, _
LookIn:=xlValues, lookat:=xlWhole)
If Not c Is Nothing Then
firstAddr = c.Address
Do
E_Data = .Range("E" & c.Row)
F_Data = .Range("F" & c.Row)
G_Data = .Range("G" & c.Row)
With Sheets("Final")
If FirstNewRow >= Newrow Then
.Range("A" & FirstNewRow) = A_Data
.Range("B" & FirstNewRow) = B_Data
End If
.Range("E" & FirstNewRow) = E_Data
.Range("F" & FirstNewRow) = F_Data
.Range("G" & FirstNewRow) = G_Data
FirstNewRow = FirstNewRow + 1
End With
Set c = .Columns("E").FindNext(after:=c)
Loop While Not c Is Nothing And c.Address <> firstAddr
If FirstNewRow > Newrow Then
Newrow = FirstNewRow
End If
End If

Next RowCount
End With
Application.ScreenUpdating = True
End Sub


Can you tell me how I can add Column H to this so it will..

1. Go to Sheet “R1” look at the contents in cell A1 then look for a
duplicate of those contents in Column C, Column E, and Column H.

2. When Column A has duplicates in Column C and Column E, and Column H copy
that row of Column A and include Column B, then copy the matching row in
Column C while including Column D, copy the matching row of column Column E
while including the same row of Column F and Column G, and finally copy the
matching row of Column H while including the same row in Column I. In other
words A:B belong together, C belong together, E:G belong together, and H:I
belong together but I want to group these Columns together based on the
contents in Columns A, C, E, and H.

3. Select worksheet “Final” and paste Columns A:B, Columns C, Columns
E:G, and Columns H:I from sheet “R1”, which may have all been in all
different rows, into the same row in sheet “Final”.

Go back to sheet “R1”and repeat the same process for every row in Column A.