compare cells and copy when match found

[Henrik]

Hi
I'm trying to compare cells on two different sheets. On
both sheets in column A I have a range of unique ID
numbers. And in sheet1 column C I have a range with dates
for each ID number.
When there is a match in column A I would like to copy the
date from sheet1 column C to sheet2 column C.
The ranges may be of different size and the match may
occur anywhere in the column.

I have found some code but do not know how to modify it to
my wishes. Can anybody help me?

Sub FindCell()

Dim X, Rng1 As Range, LstRow As Integer
Dim RowCounter As Integer
Dim lngUsedRange As Long

With Worksheets(1)
Set Rng1 = .Range(.Cells(1, "A"), .Cells
Rows.Count, "A").End(xlUp))
End With

lngUsedRange = Worksheets(1).UsedRange.Rows.Count

With Worksheets(2)
LstRow = Cells(Rows.Count, "A").End(xlUp).Row
End With

For i = LstRow To 1 Step -1
With Rng1
Set X = .Find(Worksheets(2).Cells(i, "A"), ,
xlValues)
If Not X Is Nothing Then

'do something

End If
End With
Next
End Sub

Thanks
Henrik

[J.E. McGimpsey]

One way:

This assumes that ID's are not repeated in Sheet1, or, if they do, that
only date will be returned.

Public Sub CopyCs()
Dim cell As Range
Dim found As Range
Dim rng1 As Range

With Worksheets(1)
Set rng1 = .Range(.Cells(1, 1), _
.Cells(Rows.Count, 1).End(xlUp))
End With
With Worksheets(2)
For Each cell In .Range(.Cells(1, 1), _
.Cells(Rows.Count, 1).End(xlUp))
Set found = rng1.Find( _
What:=cell.Value, _
After:=rng1(rng1.Count), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
MatchCase:=False)
If Not found Is Nothing Then _
cell.Offset(0, 2).Value = found.Offset(0, 2).Value
Next cell
End With
End Sub

In article <3ce301c2f39b$05704740$a401...@phx.gbl>, Henrik

[Henrik Kejser]

Thanks a lot!!!

With a few modifications it really helped me.

Thanks again!

Henrik

*** Sent via Developersdex http://www.developersdex.com ***
Don't just participate in USENET...get rewarded for it!