Sheet A
[TABLE="width: 500"]
<tbody>[TR]
[TD][/TD]
[TD]A[/TD]
[TD]B[/TD]
[TD]C[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]Name[/TD]
[TD]Policy[/TD]
[TD]Amount[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]Paul[/TD]
[TD]234[/TD]
[TD]50[/TD]
[/TR]
[TR]
[TD]3[/TD]
[TD]Paul[/TD]
[TD]234[/TD]
[TD]100[/TD]
[/TR]
[TR]
[TD]4[/TD]
[TD]Sharon[/TD]
[TD]365[/TD]
[TD]20[/TD]
[/TR]
[TR]
[TD]5[/TD]
[TD]sharon[/TD]
[TD]365[/TD]
[TD]40[/TD]
[/TR]
[TR]
[TD]6[/TD]
[TD]shane[/TD]
[TD]976[/TD]
[TD]100[/TD]
[/TR]
[TR]
[TD]7[/TD]
[TD]andrea[/TD]
[TD]573[/TD]
[TD]30[/TD]
[/TR]
[TR]
[TD]8[/TD]
[TD]andrea[/TD]
[TD]573[/TD]
[TD]30[/TD]
[/TR]
[TR]
[TD]9[/TD]
[TD]andrea[/TD]
[TD]573[/TD]
[TD]50[/TD]
[/TR]
</tbody>[/TABLE]
Sheet B
[TABLE="width: 500"]
<tbody>[TR]
[TD][/TD]
[TD]A[/TD]
[TD]B[/TD]
[TD]C[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]Name[/TD]
[TD]Policy[/TD]
[TD]Amount[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]Andrea[/TD]
[TD]573[/TD]
[TD]100[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]Gary[/TD]
[TD]497[/TD]
[TD]70[/TD]
[/TR]
[TR]
[TD]4[/TD]
[TD]Shane[/TD]
[TD]976[/TD]
[TD]100[/TD]
[/TR]
[TR]
[TD]5[/TD]
[TD]Paul[/TD]
[TD]234[/TD]
[TD]140[/TD]
[/TR]
[TR]
[TD]6[/TD]
[TD]Sharon[/TD]
[TD]365[/TD]
[TD]90[/TD]
[/TR]
</tbody>[/TABLE]
Sheet C
[TABLE="width: 500"]
<tbody>[TR]
[TD][/TD]
[TD]A[/TD]
[TD]B[/TD]
[TD]C[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]Name[/TD]
[TD]Policy[/TD]
[TD]Amount[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]Andrea[/TD]
[TD]573[/TD]
[TD]100[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]Andrea[/TD]
[TD]573[/TD]
[TD]30[/TD]
[/TR]
[TR]
[TD]3[/TD]
[TD]Andrea[/TD]
[TD]573[/TD]
[TD]30[/TD]
[/TR]
[TR]
[TD]4[/TD]
[TD]Andrea[/TD]
[TD]573[/TD]
[TD]50[/TD]
[/TR]
[TR]
[TD]5[/TD]
[TD]Gary[/TD]
[TD]497[/TD]
[TD]70[/TD]
[/TR]
[TR]
[TD]6[/TD]
[TD]Shane[/TD]
[TD]976[/TD]
[TD]100[/TD]
[/TR]
[TR]
[TD]7[/TD]
[TD]Paul[/TD]
[TD]234[/TD]
[TD]140[/TD]
[/TR]
[TR]
[TD]8[/TD]
[TD]Paul[/TD]
[TD]234[/TD]
[TD]50[/TD]
[/TR]
[TR]
[TD]9[/TD]
[TD]Paul[/TD]
[TD]234[/TD]
[TD]100[/TD]
[/TR]
[TR]
[TD]10[/TD]
[TD]Sharon[/TD]
[TD]365[/TD]
[TD]90[/TD]
[/TR]
[TR]
[TD]11[/TD]
[TD]Sharon[/TD]
[TD]365[/TD]
[TD]20[/TD]
[/TR]
[TR]
[TD]11[/TD]
[TD]Sharon[/TD]
[TD]365[/TD]
[TD]40[/TD]
[/TR]
</tbody>[/TABLE]
I need to produce a report as detailed in Sheet C being a concatenation of SheetsA & B as outlined.
All similar policy found in Sheet A are copied and inserted at the cell below it's corresponding policy.
So in the instance where Paul with policy number 234 is found in SheetB his matching policy is copied (entire row) form Sheet A into sheet B
Note. I have created a copy of sheet B which is used to loop over the policy range. This sheet will be the source and used to move the rows between sheets.
Here is the code thus far
Sub Macro2()
Dim i As Long, j As Long, RefLastRow As Long, MarLastRow As Long, WSLastRow As Long
Dim refPolicy As String, myWkShtAddr As String
Dim ws As Worksheet, mar As Worksheet, ref As Worksheet
Dim wsRange As Range
Dim k As Integer
Set ws = Sheets("Worksheet")
Set mar = Sheets("Marathon")
Set ref = Sheets("WS_Data")
RefLastRow = ref.Range("H" & Rows.Count).End(xlUp).Row
WSLastRow = ws.Range("H" & Rows.Count).End(xlUp).Row
For i = 2 To RefLastRow
refPolicy = ref.Cells(i, "H").Value
mar.Activate
MarLastRow = mar.Range("N" & Rows.Count).End(xlUp).Row
For j = 2 To MarLastRow
If mar.Cells(j, "N").Value = refPolicy Then
On Error Resume Next
With ws
Set wsRange = ws.Range(“H2:H” & WSLastRow).Find(What:=refPolicy, Lookin:=xlValues) '\\This gives error,not sure why.
If Not wsRange Is Nothing Then
k = 0
firstAddress = wsRange.Address
Do
mar.Select
mar.Range(Cells(j, "A")).Copy
ws.Select
NextRow = ws.Range.Address.Row + 1 '\\ Not sure how to do the insert here
Cells(NextRow, 1).Select
ActiveSheet.Paste
mar.Range(Cells(j)).EntireRow.Copy Destination:=ws.Range(wsRange).Offset(j, k)
Set wsRange = .FindNext(wsRange)
Loop While Not wsRange Is Nothing And wsRange.Address <> firstAddress
End If
End With
End If
Next j
Application.CutCopyMode = False
Next i
ref.Activate
ref.Range("A1").Select
End Sub
[TABLE="width: 500"]
<tbody>[TR]
[TD][/TD]
[TD]A[/TD]
[TD]B[/TD]
[TD]C[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]Name[/TD]
[TD]Policy[/TD]
[TD]Amount[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]Paul[/TD]
[TD]234[/TD]
[TD]50[/TD]
[/TR]
[TR]
[TD]3[/TD]
[TD]Paul[/TD]
[TD]234[/TD]
[TD]100[/TD]
[/TR]
[TR]
[TD]4[/TD]
[TD]Sharon[/TD]
[TD]365[/TD]
[TD]20[/TD]
[/TR]
[TR]
[TD]5[/TD]
[TD]sharon[/TD]
[TD]365[/TD]
[TD]40[/TD]
[/TR]
[TR]
[TD]6[/TD]
[TD]shane[/TD]
[TD]976[/TD]
[TD]100[/TD]
[/TR]
[TR]
[TD]7[/TD]
[TD]andrea[/TD]
[TD]573[/TD]
[TD]30[/TD]
[/TR]
[TR]
[TD]8[/TD]
[TD]andrea[/TD]
[TD]573[/TD]
[TD]30[/TD]
[/TR]
[TR]
[TD]9[/TD]
[TD]andrea[/TD]
[TD]573[/TD]
[TD]50[/TD]
[/TR]
</tbody>[/TABLE]
Sheet B
[TABLE="width: 500"]
<tbody>[TR]
[TD][/TD]
[TD]A[/TD]
[TD]B[/TD]
[TD]C[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]Name[/TD]
[TD]Policy[/TD]
[TD]Amount[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]Andrea[/TD]
[TD]573[/TD]
[TD]100[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]Gary[/TD]
[TD]497[/TD]
[TD]70[/TD]
[/TR]
[TR]
[TD]4[/TD]
[TD]Shane[/TD]
[TD]976[/TD]
[TD]100[/TD]
[/TR]
[TR]
[TD]5[/TD]
[TD]Paul[/TD]
[TD]234[/TD]
[TD]140[/TD]
[/TR]
[TR]
[TD]6[/TD]
[TD]Sharon[/TD]
[TD]365[/TD]
[TD]90[/TD]
[/TR]
</tbody>[/TABLE]
Sheet C
[TABLE="width: 500"]
<tbody>[TR]
[TD][/TD]
[TD]A[/TD]
[TD]B[/TD]
[TD]C[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]Name[/TD]
[TD]Policy[/TD]
[TD]Amount[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]Andrea[/TD]
[TD]573[/TD]
[TD]100[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]Andrea[/TD]
[TD]573[/TD]
[TD]30[/TD]
[/TR]
[TR]
[TD]3[/TD]
[TD]Andrea[/TD]
[TD]573[/TD]
[TD]30[/TD]
[/TR]
[TR]
[TD]4[/TD]
[TD]Andrea[/TD]
[TD]573[/TD]
[TD]50[/TD]
[/TR]
[TR]
[TD]5[/TD]
[TD]Gary[/TD]
[TD]497[/TD]
[TD]70[/TD]
[/TR]
[TR]
[TD]6[/TD]
[TD]Shane[/TD]
[TD]976[/TD]
[TD]100[/TD]
[/TR]
[TR]
[TD]7[/TD]
[TD]Paul[/TD]
[TD]234[/TD]
[TD]140[/TD]
[/TR]
[TR]
[TD]8[/TD]
[TD]Paul[/TD]
[TD]234[/TD]
[TD]50[/TD]
[/TR]
[TR]
[TD]9[/TD]
[TD]Paul[/TD]
[TD]234[/TD]
[TD]100[/TD]
[/TR]
[TR]
[TD]10[/TD]
[TD]Sharon[/TD]
[TD]365[/TD]
[TD]90[/TD]
[/TR]
[TR]
[TD]11[/TD]
[TD]Sharon[/TD]
[TD]365[/TD]
[TD]20[/TD]
[/TR]
[TR]
[TD]11[/TD]
[TD]Sharon[/TD]
[TD]365[/TD]
[TD]40[/TD]
[/TR]
</tbody>[/TABLE]
I need to produce a report as detailed in Sheet C being a concatenation of SheetsA & B as outlined.
All similar policy found in Sheet A are copied and inserted at the cell below it's corresponding policy.
So in the instance where Paul with policy number 234 is found in SheetB his matching policy is copied (entire row) form Sheet A into sheet B
Note. I have created a copy of sheet B which is used to loop over the policy range. This sheet will be the source and used to move the rows between sheets.
Here is the code thus far
Sub Macro2()
Dim i As Long, j As Long, RefLastRow As Long, MarLastRow As Long, WSLastRow As Long
Dim refPolicy As String, myWkShtAddr As String
Dim ws As Worksheet, mar As Worksheet, ref As Worksheet
Dim wsRange As Range
Dim k As Integer
Set ws = Sheets("Worksheet")
Set mar = Sheets("Marathon")
Set ref = Sheets("WS_Data")
RefLastRow = ref.Range("H" & Rows.Count).End(xlUp).Row
WSLastRow = ws.Range("H" & Rows.Count).End(xlUp).Row
For i = 2 To RefLastRow
refPolicy = ref.Cells(i, "H").Value
mar.Activate
MarLastRow = mar.Range("N" & Rows.Count).End(xlUp).Row
For j = 2 To MarLastRow
If mar.Cells(j, "N").Value = refPolicy Then
On Error Resume Next
With ws
Set wsRange = ws.Range(“H2:H” & WSLastRow).Find(What:=refPolicy, Lookin:=xlValues) '\\This gives error,not sure why.
If Not wsRange Is Nothing Then
k = 0
firstAddress = wsRange.Address
Do
mar.Select
mar.Range(Cells(j, "A")).Copy
ws.Select
NextRow = ws.Range.Address.Row + 1 '\\ Not sure how to do the insert here
Cells(NextRow, 1).Select
ActiveSheet.Paste
mar.Range(Cells(j)).EntireRow.Copy Destination:=ws.Range(wsRange).Offset(j, k)
Set wsRange = .FindNext(wsRange)
Loop While Not wsRange Is Nothing And wsRange.Address <> firstAddress
End If
End With
End If
Next j
Application.CutCopyMode = False
Next i
ref.Activate
ref.Range("A1").Select
End Sub