need help on refining find record macro



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

Many thanks

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")

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

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


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, _
If Not rng Is Nothing Then
mkAddr = rng.Address
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
MsgBox "Nothing Found"
End If
End With

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question