compare 2 times and if past midnight then mark it as next day

Question

I have a log file with 420,000 lines of logon entries, I have a time stamp in Column D and a logon name in Column E. Now I don't know when the log file was started but I can see where today's logons are so wanted to work backwards through the sheet.

So now to the question, I have todays logons and the last entry (working backwards) is:

06:09:42 | Joe Bloggs

Then the one above it is:

21:27:36 | Adam Jones

Is there a way of running through Column A and when you get to this situation start inputting the previous days date.

EDIT:

This is the code I have at the moment don't know if it is the best way to do it:

Sub DateStamp()
    Dim WS1 As Worksheet
    Dim lRow As Long

    Set WS1 = ThisWorkbook.Sheets("Sheet1")

    lRow = WS1.Cells(Rows.Count, 4).End(xlUp).Row

    strDate = Date

    Do Until lRow = 2

        If WS1.Cells(lRow, 4).Value > WS1.Cells(lRow, 4).Offset(-1, 0).Value + TimeSerial(12, 0, 0) Then
            strDate = strDate - 1
            WS1.Cells(lRow, 4).Offset(0, -2).Value = strDate
        Else
            WS1.Cells(lRow, 4).Offset(0, -2).Value = strDate
        End If

        lRow = lRow - 1

    Loop

End Sub

This code doesn't quite work at the moment as any time that is close to midnight will then mark it as the next day

Example entries

Thanks in advance

Answer 1

Assuming that:

1. Last row refers to today date

2. You have enough log row for each day

3. Your row 1 is an header, row 2 contains data

4. Following data could be example entries for your problem

   NotInteresting  |DateGoesHere   |NotInteresting |Time       |Logon_Name
   1               |               |This           |13:06:24   |Adam Jones
   2               |               |column         |16:40:56   |Bill Bao
   3               |               |is             |03:02:30   |Joe Bloggs
   4               |               |not            |08:41:02   |Jhon Doe
   5               |               |interesting    |19:30:36   |Iam Igor
   6               |               |but            |04:06:52   |Pinco Pallino
   7               |               |I              |13:49:59   |Romolo Remo
   8               |               |know           |17:08:04   |Harry Potter
   9               |               |that           |18:26:52   |Jane Doe
   10              |               |last           |21:27:36   |Adam Jones
   11              |               |row            |06:09:42   |Joe Bloggs
   12              |               |date           |07:00:02   |Iam Igor
   13              |               |is today       |12:40:08   |Pinco Pallino
   

   and the expected result is:

   NotInteresting  |DateGoesHere       |NotInteresting |Time       |Logon_Name
   1               |   29/04/2020      |This           |13:06:24   |Adam Jones
   2               |   29/04/2020      |column         |16:40:56   |Bill Bao
   3               |   30/04/2020      |is             |03:02:30   |Joe Bloggs
   4               |   30/04/2020      |not            |08:41:02   |Jhon Doe
   5               |   30/04/2020      |interesting    |19:30:36   |Iam Igor
   6               |   01/05/2020      |but            |04:06:52   |Pinco Pallino
   7               |   01/05/2020      |I              |13:49:59   |Romolo Remo
   8               |   01/05/2020      |know           |17:08:04   |Harry Potter
   9               |   01/05/2020      |that           |18:26:52   |Jane Doe
   10              |   01/05/2020      |last           |21:27:36   |Adam Jones
   11              |   02/05/2020      |row            |06:09:42   |Joe Bloggs
   12              |   02/05/2020      |date           |07:00:02   |Iam Igor
   13              |   02/05/2020      |is today       |12:40:08   |Pinco Pallino
   

Keep in mind that doing (as you are doing):

If WS1.Cells(lRow, 4).Value > WS1.Cells(lRow, 4).Offset(-1, 0).Value + TimeSerial(12, 0, 0) Then
    strDate = strDate - 1
    WS1.Cells(lRow, 4).Offset(0, -2).Value = strDate
Else
    WS1.Cells(lRow, 4).Offset(0, -2).Value = strDate
End If

is the same thing doing that:

If WS1.Cells(lRow, 4).Value > WS1.Cells(lRow, 4).Offset(-1, 0).Value + TimeSerial(12, 0, 0) Then
    strDate = strDate - 1
End If
    WS1.Cells(lRow, 4).Offset(0, -2).Value = strDate

In addition you have to think what does think you mind when you understand that if a cell contains 06:09:42 and the upper one contains 21:27:36 then you are talking about 2 different days? It's because the upper cell is more big than the lower cell, but the upper has to be a timestamp (date+time) smaller than the lower.

So if condition need to be something like:

If WS1.Cells(lRow, 4).Value < WS1.Cells(lRow, 4).Offset(-1, 0).Value Then
    strDate = strDate - 1
End If

And complete code would be:

Sub DateStamp()
    Dim WS1 As Worksheet
    Dim lRow As Long

    Set WS1 = ThisWorkbook.Sheets("Sheet1")

    lRow = WS1.Cells(Rows.Count, 4).End(xlUp).Row

    strDate = Date

    Do Until lRow = 2

        WS1.Cells(lRow, 4).Offset(0, -2).Value = strDate

        'If upper cell has a time bigger than the one in the current cell
        'Than we are talking of two different days. Maybe is the day before.
        If WS1.Cells(lRow, 4).Value < WS1.Cells(lRow, 4).Offset(-1, 0).Value Then
            strDate = strDate - 1
        End If
        lRow = lRow - 1

    Loop

End Sub

This code will not fill the first data row (row number 2). To do it you have to change the Until condition of the Do loop in order to include row number 2 and in the case of row number 2 don't check the previous row (it doesn't contain a valid time).

Sub DateStamp()
    Dim WS1 As Worksheet
    Dim lRow As Long

    Set WS1 = ThisWorkbook.Sheets("Sheet1")

    lRow = WS1.Cells(Rows.Count, 4).End(xlUp).Row

    strDate = Date

    Do Until lRow < 2   'It stops when lRow is strictly less than 2. Include lRow = 2

        WS1.Cells(lRow, 4).Offset(0, -2).Value = strDate

        'Doesn't run for lRow = 2
        If lRow > 2 Then
            If WS1.Cells(lRow, 4).Value < WS1.Cells(lRow, 4).Offset(-1, 0).Value Then
                strDate = strDate - 1
            End If
        End If

        lRow = lRow - 1
    Loop

End Sub

P.s. You can avoid using offsets in those cases

WS1.Cells(lRow, 4).Offset(0, -2)
WS1.Cells(lRow, 4).Offset(-1, 0)

replacing them with

WS1.Cells(lRow, 2)
WS1.Cells(lRow-1, 4)