Search & return results with latest datestamp

[Scoti]

fibder.txtHi all,
I am currently running a workbook which tracks various items through a process. I have tabs for each step of the
process where the items are logged in and then out of before being sent to the next process. I have a macro which allows me to search for an item and tell me where exactly it is in the process however it is not providing me with the last "movement" or latest timestamp. In this macro the item will appear in sheets Man_Completed, Man_Received, Completed, & Received but I just need the info returned from the sheet containing the latest timestamp for that particular item. Does that make sense?

 

[davesexcel]

You can supply your code instead of creating a link to the file that has your code.

 

[Scoti]

Sub findSample()

Dim FindString As String

Dim Rng As Range

Set Sheet = Sheets("Retest")

Application.ScreenUpdating = False

For Each cell In Range("C2:C50")

FindString = cell.Value





With Sheets("Man_Completed").Range("C:C")

Set Rng = .Find(What:=FindString, _

After:=.Cells(.Cells.Count), _

LookIn:=xlValues, _

LookAt:=xlWhole, _

SearchOrder:=xlByRows, _

SearchDirection:=xlNext, _

MatchCase:=False)



If Not Rng Is Nothing Then

Application.Goto Rng, True



TheDepartment = ActiveCell.Offset(0, 2).Value

TheDate = ActiveCell.Offset(0, 3).Value



cell.Offset(0, 12).Value = TheDepartment

cell.Offset(0, 13).Value = TheDate





End If

End With

With Sheets("Man_Received").Range("D:D")

Set Rng = .Find(What:=FindString, _

After:=.Cells(.Cells.Count), _

LookIn:=xlValues, _

LookAt:=xlWhole, _

SearchOrder:=xlByRows, _

SearchDirection:=xlNext, _

MatchCase:=False)

If Not Rng Is Nothing Then

Application.Goto Rng, True



TheDepartment = ActiveCell.Offset(0, -2).Value

TheDate = ActiveCell.Offset(0, -1).Value



cell.Offset(0, 12).Value = TheDepartment

cell.Offset(0, 13).Value = TheDate





End If

End With

Sheet.Activate





With Sheets("Completed").Range("C:C")

Set Rng = .Find(What:=FindString, _

After:=.Cells(.Cells.Count), _

LookIn:=xlValues, _

LookAt:=xlWhole, _

SearchOrder:=xlByRows, _

SearchDirection:=xlNext, _

MatchCase:=False)



If Not Rng Is Nothing Then

Application.Goto Rng, True



TheDepartment = ActiveCell.Offset(0, 2).Value

TheDate = ActiveCell.Offset(0, 3).Value



cell.Offset(0, 12).Value = TheDepartment

cell.Offset(0, 13).Value = TheDate





End If

End With

With Sheets("Received").Range("D:D")

Set Rng = .Find(What:=FindString, _

After:=.Cells(.Cells.Count), _

LookIn:=xlValues, _

LookAt:=xlWhole, _

SearchOrder:=xlByRows, _

SearchDirection:=xlNext, _

MatchCase:=False)

If Not Rng Is Nothing Then

Application.Goto Rng, True



TheDepartment = ActiveCell.Offset(0, -2).Value

TheDate = ActiveCell.Offset(0, -1).Value



cell.Offset(0, 12).Value = TheDepartment

cell.Offset(0, 13).Value = TheDate





End If

End With

Sheet.Activate

Next

End Sub