Enter “end time” of task in cell based on user ID entry in later column.

  • I am setting up a spreadsheet to track information about tasks completed by employees. The way i want this to work is that an employee will have their ID scanned into the spreadsheet at the start of each task.

    I have set up a sheet that allows the scanning/entry of the employee ID into column D and auto-populates an adjacent cell (column E) with the current date/time.

    The bit i am struggling with is entering the "end time" of the task; when the same employee returns for a subsequent and has their badge scanned into the sheet i want the finish time of the previous task to be entered into column F of the row associated with that task. My knowledge of VBA is very limited, and i can't think of a simple way to achieve this.

    The table looks like this: https://imgur.com/a/uz6unv7

    I found some code online that I've tried to edit. The basis i'm trying to work on is for the code to: - Search for values of a given employee ED in column D - when a matching ID is found, copy column E from the "found row" into column F of the original row. - it should then work through the whole of column D, stopping at each instance of the matching ID, copying and pasting as above, then moving on through the column.

    Code below:

    [VBA]Sub FindCopy()
    Dim calc As Long
    Dim Cel As Range
    Dim LastRow As Long
    Dim rFound As Range
    Dim LookRange As Range
    Dim CelValue As Variant
    ' Speed
    calc = Application.Calculation
    With Application
    .Calculation = xlCalculationManual
    .ScreenUpdating = False
    End With
    'Get Last row of data Sheet2, Col D (Stager ID)
    LastRow = Sheet2.Cells(Rows.Count, 4).End(xlUp).Row
    ' Set range to look in (Stager ID)
    Set LookRange = Sheet2.Range("D2:D" & LastRow)
    ' Loop on each value (cell)
    For Each Cel In LookRange
    ' Get value to find
    CelValue = Cel.Value
    ' Look on sheet2
    With Sheet2
    ' Allow not found error
    On Error Resume Next
    Set rFound = .Cells.Find(What:=CelValue, _
    After:=.Cells(1, 1), LookIn:=xlValues, _
    LookAt:=xlWhole, MatchCase:=False)
    ' Reset
    On Error GoTo endo
    ' Not found, go next
    If rFound Is Nothing Then
    GoTo nextCel
    ' Found. Copy Sheet2, Col E to Sheet2 found Row, Col F
    Sheet2.Cells(Cel.Row, 6).Value = Sheet2.Cells(rFound.Row, 5).Value
    End If
    End With
    Next Cel
    With Application
    .Calculation = calc
    .ScreenUpdating = True
    End With
    End Sub [/VBA]

    [SIZE=14px]Unfortunately, currently it just pastes the first value of column E into column F for all rows associated with that employee ID. I want it to determine the finish time for each task independently, such that i can calculate the duration of each task. Does anyone know how to correct the code i'm using, or another (possibly much easier way) to achieve the above? Is it possible to set this up to populate "live" i.e. as employee IDs are entered? [/SIZE]