Match and Reconcile

[sylink]

I have a need for a macro to do a simple match of figures in 2 sheets:

The macro should match Amt, REF and RT in sheets 1&2
Where there is match, should write in sheet2 corresponding S/N from
sheet1

Sheet1
S/N Amt REF RT

001 200 w1 john
002 100 e3 Pet
003 400 y7 Yep
004 600 z7 Pet


Sheet2
S/N Amt REF RT

001 400 y7 Yep
002 200 w1 john
003 100 e3 Pet
004 600 z7 Pet


Assumption
The number of row undetermined


Result format: the final result in sheet2 should appear as shown
below.

Sheet2
S/N Amt REF RT S/N(from sheet1)

001 400 y7 Yep 003
002 200 w1 john 001
003 100 e3 Pet 002
004 600 z7 Pet 004

 

[Per Jessen]

HI

Try this:

Sub Compare()
Dim ShA As Worksheet
Dim ShB As Worksheet
Dim FirstRow As Long
Dim LastRow As Long
Dim f As Range

Set ShA = Worksheets("Sheet1")
Set ShB = Worksheets("Sheet2")

FirstRow = 3 'First row with data
LastRow = ShA.Range("A" & Rows.Count).End(xlUp).Row

For r = FirstRow To LastRow
Set f = ShB.Columns("B").Find(what:=ShA.Range("B" & r).Value,
LookIn:=xlValues, lookat:=xlWhole)
If Not f Is Nothing Then
If ShA.Range("C" & r) = f.Offset(0, 1).Value And ShA.Range("D" &
r).Value = f.Offset(0, 2).Value Then
f.Offset(0, 3) = ShA.Range("A" & r).Value
End If
End If
Set f = Nothing
Next
End Sub

Regards,
Per

 

[sylink]

HI

Try this:

Sub Compare()
Dim ShA As Worksheet
Dim ShB As Worksheet
Dim FirstRow As Long
Dim LastRow As Long
Dim f As Range

Set ShA = Worksheets("Sheet1")
Set ShB = Worksheets("Sheet2")

FirstRow = 3 'First row with data
LastRow = ShA.Range("A" & Rows.Count).End(xlUp).Row

For r = FirstRow To LastRow
    Set f = ShB.Columns("B").Find(what:=ShA.Range("B" & r).Value,
LookIn:=xlValues, lookat:=xlWhole)
    If Not f Is Nothing Then
        If ShA.Range("C" & r) = f.Offset(0, 1).Value And ShA.Range("D" &
r).Value = f.Offset(0, 2).Value Then
            f.Offset(0, 3) = ShA.Range("A" & r).Value
        End If
    End If
    Set f = Nothing
Next
End Sub

Regards,
Per

Thank you Per. I'll give a try.