find, Match, Copy from onesheet to other

S

Sissy

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.
 
Top