Macro to match / reconcile data : One to Many

[capricorn.man]

Hi all,

I really need some help on writing a macro to slove the following
problem.

I have 2 sheets of data which i need to match off against each other.

Each sheet contains similar data and headers. However, my problem is
that the first sheet contains one line of data that needs to be
matched to multiple lines of data in the second sheet, and i need to
output the matched data into a third sheet called "Matched".

I am able to do so if the data is for one to one match but is lost for
one to many. Could someone help me please.

I have attached the code for one to one matching below.

-----------------------------------------------------------------------------------------------------------------------


Counter = 1

Sheets("CustA Details").Select
Cells.Find(What:="T.Date", _
After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlPart,
SearchOrder:= _
xlByRows, SearchDirection:=xlNext, MatchCase:=False,
SearchFormat:=False) _
.Activate
BeginRow = ActiveCell.Row + 1

Range("A65535").End(xlUp).Select
EndRow = ActiveCell.Row

For E = BeginRow To EndRow Step 1
Sheets("CustA Details").Select
Cells(E, 1).Select
TradeDate = Cells(E, 1).Value
Medium = Cells(E, 2).Value
Product = Cells(E, 3).Value
ContractDate = Cells(E, 4).Text
CP = Cells(E, 5).Value
Buy = Cells(E, 6).Value
Sell = Cells(E, 7).Value
Strike = Cells(E, 8).Value
Price = Cells(E, 9).Value
CCY = Cells(E, 11).Value
Matcher = Left(Cells(E, 16), 7)

Sheets("CustB Details").Select
Cells.Find(What:="T. Date", After:=ActiveCell,
LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:= _
xlByRows, SearchDirection:=xlNext, MatchCase:=False,
SearchFormat:=False) _
.Activate
BeginRow1 = ActiveCell.Row + 1

Range("A65535").End(xlUp).Select
EndRow1 = ActiveCell.Row

For F = BeginRow1 To EndRow1 Step 1
Sheets("CustB Details").Select
Cells(F, 16).Select
TradeDate_U = Cells(F, 1).Value
Medium_U = Cells(F, 2).Value
Product_U = Cells(F, 3).Value
CustNum_U = Cells(F, 4).Value
DealRef_U = Cells(F, 5).Value
ContractDate_U = Cells(F, 6).Text
CP_U = Cells(F, 7).Value
Buy_U = Cells(F, 8).Value
Sell_U = Cells(F, 9).Value
Strike_U = Cells(F, 11).Value
Price_U = Cells(F, 12).Value
CCY_U = Cells(F, 10).Value
Matcher_U = Left(Cells(F, 16), 7)

If TradeDate = TradeDate_U _
And Medium = Medium_U And CP = CP_U _
And Buy = Buy_U And Sell = Sell_U _
And CCY = CCY_U And Strike = Strike_U And Price = Price_U
_
And Matcher <> "Matched" And Matcher_U <> "Matched" Then

Sheets("CustA Details").Select
Cells(E, 16).Value = "Matched " & Counter
Sheets("CustB Details").Select
Cells(F, 16).Value = "Matched " & Counter

Sheets("Matched").Select
Range("A65535").End(xlUp).Select
EndRowMatch = ActiveCell.Row
Cells(EndRowMatch + 1, 1).Select
Cells(EndRowMatch + 1, 1).Value = TradeDate
Cells(EndRowMatch + 1, 2).Value = Medium
Cells(EndRowMatch + 1, 3).Value = Product
Cells(EndRowMatch + 1, 6).Value = ContractDate
Cells(EndRowMatch + 1, 7).Value = CP
Cells(EndRowMatch + 1, 8).Value = Buy
Cells(EndRowMatch + 1, 9).Value = Sell
Cells(EndRowMatch + 1, 11).Value = Strike
Cells(EndRowMatch + 1, 12).Value = Price
Cells(EndRowMatch + 1, 10).Value = CCY
Cells(EndRowMatch + 1, 13).Value = "Matched " &
Counter
ActiveCell.EntireRow.Interior.ColorIndex = 36

Cells(EndRowMatch + 2, 1).Select
Cells(EndRowMatch + 2, 1).Value = TradeDate_U
Cells(EndRowMatch + 2, 2).Value = Medium_U
Cells(EndRowMatch + 2, 3).Value = Product_U
Cells(EndRowMatch + 2, 4).Value = CustNum_U
Cells(EndRowMatch + 2, 5).Value = DealRef_U
Cells(EndRowMatch + 2, 6).Value = ContractDate_U
Cells(EndRowMatch + 2, 7).Value = CP_U
Cells(EndRowMatch + 2, 8).Value = Buy_U
Cells(EndRowMatch + 2, 9).Value = Sell_U
Cells(EndRowMatch + 2, 11).Value = Strike_U
Cells(EndRowMatch + 2, 12).Value = Price_U
Cells(EndRowMatch + 2, 10).Value = CCY_U
Cells(EndRowMatch + 2, 13).Value = "Matched " &
Counter
ActiveCell.EntireRow.Interior.ColorIndex = 35

Counter = Counter + 1
Exit For
Else
End If

Next F
Next E

 

[capricorn.man]

Hi all,

Sorry, i forgot to mention that i am using MS Excel 2003.

Thanks