Matching and Copying entries

[Box666]

I have two worksheets, on sheet1 there are 4 columns, columnA is the
customers account number. On sheet2 I have 5 columns and again columnA
is the customers account number.

I want to keep all records from sheet1, but I want to add two extra
columns of data that is currently held on sheet2.

So I think I need to compare the customers account numbers between
sheet1 and sheet2 and where they match copy over columns C and E from
sheet2 to two new colmns on sheet1.

What would be the best eay to approach this problem. (I have approx
20,000 rows on sheet1 and nearly 50,000 on sheet2.)

 

[Otto Moehrbach]

You say that Column A of both sheets have customer account numbers. You
also say sheet 2 has 50,000 rows while sheet 1 has only some 20,000 rows. I
take it that any account number found on sheet 1 will not appear more than
once, if at all, on sheet 2. If this is true, then the following macro will
do what you want. Note that, as written, this macro assumes that sheet
"One" is the active sheet. This is the sheet you refer to as "sheet1".
HTH Otto
Sub UpdateData()
Dim AN2 As Range 'Account number range in sheet Two
Dim AN1 As Range 'Account number range in sheet One
Dim i As Range
Dim MatchAN1 As Range 'AN in One that matches that in Two
Application.ScreenUpdating = False
Set AN1 = Range("A2", Range("A" & Rows.Count).End(xlUp))
With Sheets("Two")
Set AN2 = .Range("A2", .Range("A" & Rows.Count).End(xlUp))
For Each i In AN2
On Error Resume Next
Set MatchAN1 = AN1.Find(What:=i.Value, LookAt:=xlWhole)
On Error GoTo 0
If Not MatchAN1 Is Nothing Then
i.Offset(, 2).Copy MatchAN1.Offset(, 4)
i.Offset(, 4).Copy MatchAN1.Offset(, 5)
End If
Next i
End With
Application.ScreenUpdating = True
End Sub