find, Match, Copy from onesheet to other
 

Hi all
Look at my codes below.It does matches two columns in old and new
worksheet and copies it into other sheet.
All together there are 3 worksheets.
I want now two worksheets.
Worksheet(Old) and worksheet(new).
In both sheets it matches two columns A and B. After matching it it
copies it to the 3rd sheet named Oldmatch.
Now I want that when the Column A and B of old matches with A and B of
new. Then it should select the
entire row data from old starting from ColC and copy it to worksheet
named New in the corresponding match AB
in Col C of New worksheet.




With Worksheets("New")
Set rngNewA = .Range(.Cells(2, "A"), _
..Cells(Rows.Count, "A").End(xlUp))
End With
With Worksheets("Old")
Set rngOldA = .Range(.Cells(2, "A"), _
..Cells(Rows.Count, "A").End(xlUp))
End With
rowMatchAB = 1
rowMatchAonly = 1
rowNoMatch = 1
shMatchAB = "Oldmatch"
shMatchAonly = "Oldonematch"
shnoMatch = "Oldnomatch"

For Each celold In rngOldA
MatchResults = "NoMatch"
For Each celNew In rngNewA
If celold.Value = celNew.Value Then
' At least A range matches
If celold(1, 2).Value = celNew(1, 2).Value Then
'A and H range matches
MatchResults = "AB"

Else
'Only A range matches
If MatchResults < "AB" Then
MatchResults = "A"

End If
End If
End If
'No match yet, keep looking
Next celNew
If MatchResults = "AB" Then
'Matches A And B
celold.EntireRow.Copy Destination:= _
Worksheets(shMatchAB).Cells(rowMatchAB, "A")
rowMatchAB = rowMatchAB + 1
ElseIf MatchResults = "A" Then
' Only A matches
celold.EntireRow.Copy Destination:= _
Worksheets(shMatchAonly).Cells(rowMatchAonly, "A")
rowMatchAonly = rowMatchAonly + 1
ElseIf MatchResults = "NoMatch" Then
'No match
celold.EntireRow.Copy Destination:= _
Worksheets(shnoMatch).Cells(rowNoMatch, "A")


End If
Next celold




Any help would be appreciated .

Thanx in advance.