Compare same data of column in two workbooks

[John Chen]

Hello,

I have two workbooks. Both of them has 5 columns. 1st column (date), 2nd column (product code), 3rd column (product type) 4th column (account number) and last column is remark (enter by staffs)

Every week, I receive files from other department and name as e.g. week 1, week 2. Week 1 file has the data of remark (column 5) Its related to delinquency accounts.

If there are same accounts number in two workbooks (colum 4) , for example as compare week 1 excel and week 2 excel files, I would like to write the macro to copy remark (column 5) of same account from week 1 file to week 2 ( for example, in week 1, there is remark for account 123-456789, not yet pay the debt). If I receive week2 report, the account still is in excel, I can copy the remark from week 1 excel to week 2 excel.


In the internet, I found one macro quite similar to this one. however, I need to modify it (matching criteria is for column 4, same account number in two workbooks) . thanks
===================================
Sub RankOtherWorkbook()
Dim otherBook As Workbook

Dim thisSheet As Worksheet
Dim otherSheet As Worksheet


Dim thisCell As Range
Dim otherCell As Range

Set otherBook = Workbooks("Book2.xls")
Set thisSheet = ThisWorkbook.Sheets("Sheet1")
Set otherSheet = otherBook.Sheets("Sheet1")

Set otherCell = otherSheet.Cells(2, 1)
Do While Not IsEmpty(otherCell)
otherCell.Offset(0, 3).Value = "#NA"
Set thisCell = thisSheet.Cells(1, 1)
Do
Set thisCell = thisCell.Offset(1, 0)
If (thisCell.Value = otherCell.Value And _
thisCell.Offset(0, 1).Value <= otherCell.Offset(0, 1).Value And _
thisCell.Offset(0, 2).Value >= otherCell.Offset(0, 2).Value) Then
otherCell.Offset(0, 3).Value = thisCell.Offset(0, 3)

End If
Loop Until IsEmpty(thisCell)
Set otherCell = otherCell.Offset(1, 0)
Loop
End Sub

 

[GS]

Try this...

Sub CompareData()
Dim rngSource As Range, rngTarget As Range, rng As Range
Dim lLastRow As Long, lRow As Long

Set rngTarget =
Workbooks("Book2.xls").Sheets("Sheet1").Range("$D:$D")
Set rngSource = ThisWorkbook.Sheets("Sheet1").Range("$D:$D")
lLastRow = rngSource.Rows(rngSource.Rows.Count).End(xlUp).Row

For lRow = 1 To lLastRow
Set rng = _
rngTarget.Find(What:=rngSource.Cells(lRow), LookAt:=xlWhole)
If Not rng Is Nothing Then _
rng.Offset(, 1) = rngSource.Cells(lRow).Offset(, 1)
Next
End Sub