need help on refining find record macro

[burl_h]

The following code finds the record on the 2nd sheet that matches the
entry in cell a1 of the 1st sheet. I also want to check the record
immediately to the right of the found record on sheet 2 to see if it
matches the entry in cell b1 on sheet 1. The entry in cell b1 of sheet
1 will eventually be formatted as date and time, this should make it
unique. The entry in cell a1 on sheet 1 will be a part number, there
maybe many occurances of the required part number on sheet 2 but only
1 should match the time and date stamp. When the record is found (part
number) and the matching date and time match then in the 4rd column I
place the text "Approved". The macro works fine when their is only 1
matching part number on sheet 2, when multiple occurances of the same
part number are added it doesn't work. Any suggestion would be greatly
appreciated

Many thanks
burl_h


Dim wsSource As Worksheet
Dim wsDest As Worksheet
Dim tofind As Range
Dim datetofind As Range
Dim Rng As Range


With Application
.ScreenUpdating = False
.EnableEvents = False
End With

Set wsSource = Worksheets("Sheet1")
Set wsDest = Worksheets("Sheet2")

Set tofind = wsSource.Range("a1")
Set datetofind = wsSource.Range("b1")


With wsDest.Range("a:a")
Range("A1").Select

Set Rng = .Find(What:=tofind, After:=ActiveCell,
LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious,
MatchCase:= _
False)
If Not Rng Is Nothing Then
Application.Goto Rng, True
If ActiveCell.Offset(0, 1) = datetofind Then
ActiveCell.Offset(0, 2) = "Approved"
End If
Else
MsgBox "Nothing Found"
End If
End With

With Application
.ScreenUpdating = True
.EnableEvents = True
End With

 

[JLGWhiz]

This modifies your find statement somewhat. I did not fully test it but it
compiles so it should run. Give it a try.

With wsDest.Range("a:a")
Set rng = .Find(What:=tofind, After:=Range("A1"), LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, _
MatchCase:=False)
If Not rng Is Nothing Then
mkAddr = rng.Address
Do
If rng.Offset(0, 1) = datetofind Then
rng.Offset(0, 2) = "Approved"
End If
Set rng = .FindNext(rng)
Loop While Not rng Is Nothing And rng.Address <> mkAddr
Else
MsgBox "Nothing Found"
End If
End With

 

[burl_h]

jlgwhiz,

thanks for you assistance, your soluttion worked great.

Many thanks
burl_h