CODEWITHSUNDEEP
vbaexceldate
tulanejosh
tulanejosh

Reputation: 319

Compare Time in VBA

Friends,

I'm trying to scan a column of times and copy/paste the row if the timestamp is within the past two minutes + 7 hours. The date portion of my timestamps don't lineup and I need to convert them to the same date without changing the time.

Here is my code:

Sub Timecompare()

Dim i As Integer
Dim lRow As Integer
Dim ws1 As Worksheet
Dim ws2 As Worksheet

Set ws1 = Sheets("Volm")
Set ws2 = Sheets("Sheet2")

'goal:
'scan all rows in dataset
'if cell time > current time - 2 minutes
'copy pasta

With ws1
    'find the last row
    lRow = .Cells(.Rows.Count, "E").End(xlUp).Row
    'loop through all the rows
    For i = 10 To lRow
        'if the cell value is greater than time + 7 hours - 2 minutes then copy/paste the row to new sheet
        If .Cells(i, 18).Value > Now + TimeSerial(7, 0, 0) - TimeSerial(0, 2, 0) Then
            ''' just spitting out the values in the comparator above so I can see the results and why they aren't comparing properly '''
            ws2.Cells(i, 1).Value = .Cells(i, 18).Value
            ws2.Cells(i, 2).Value = Now + TimeSerial(7, 0, 0) - TimeSerial(0, 2, 0)
            Exit For
        End If
    Next i

End With

End Sub

The ".Cells(i, 18).Value" output looks like this: .704461794 (general format) or 1/0/00 4:54 PM (date format)

The "Now + TimeSerial(7, 0, 0) - TimeSerial(0, 2, 0)" output looks like this: 42467.75336 (general format) or 4/7/16 6:04 PM (date format).

I don't care about the date. All I care about is the time. So is there a way to bring the ".Cells(i, 18).Value" to today with the same time OR take the Now() + 7 hours - 2 minutes date back to 1/0/00? To reiterate, I'm just trying to get my apples to apples so i can compare times.

Upvotes: 0

Views: 6945

Answers (3)

Florent B.
Florent B.

Reputation: 42518

I would simply extract the time:

upperTime = GetTime(Now + TimeSerial(7, 0, 0) - TimeSerial(0, 2, 0))

With ws1
  For i = 10 To lRow

      ' compare on the time only '
      If GetTime(.Cells(i, 18).Value) > upperTime Then

          ' copy the time only '
          ws2.Cells(i, 1).Value = GetTime(.Cells(i, 18).Value)

          ' copy the current date plus the time from the cell '
          ws2.Cells(i, 2).Value = GetDate(Now) + GetTime(.Cells(i, 18).Value)

          Exit For
      End If
  Next i
End With

The functions to extract the date part or the time part:

' Returns the date part from a date/time '
Public Function GetTime(datetime As Date) As Date
  GetTime = datetime - VBA.Fix(datetime)
End Function

' Returns the time part from a date/time '
Public Function GetDate(datetime As Date) As Date
  GetDate = VBA.Fix(datetime)
End Function

Upvotes: 2

PeterT
PeterT

Reputation: 8557

I believe your algorithm has to take midnight crossings into account. Based on the wording of your problem (above your code sample), I tried the following test:

Option Explicit

Sub test()
    Dim pastLimit As Date
    Dim futureLimit As Date
    Dim timestamps() As Variant
    Dim testtime As Variant

    timestamps = Array(DateValue("4/7/2016") + TimeValue("12:43:00 PM"), _
                       DateValue("4/7/2016") + TimeValue(" 1:43:00 PM"), _
                       DateValue("4/7/2016") + TimeValue(" 2:43:00 PM"), _
                       DateValue("4/7/2016") + TimeValue(" 3:43:00 PM"), _
                       DateValue("4/7/2016") + TimeValue(" 4:43:00 PM"), _
                       DateValue("4/7/2016") + TimeValue(" 5:43:00 PM"))

    pastLimit = Now + TimeSerial(0, 2, 0)
    futureLimit = Now + TimeSerial(7, 0, 0) - TimeSerial(0, 2, 0)

    For Each testtime In timestamps
        If (testtime > pastLimit) And (testtime < futureLimit) Then
            Debug.Print "in the window: " & Format(testtime, "hh:mm:ss ampm")
        End If
    Next testtime

End Sub

This seemingly gives your desired results.

Upvotes: 0

MikeC
MikeC

Reputation: 958

Create a variable and assign Now + TimeSerial(7, 0, 0) - TimeSerial(0, 2, 0) to it outside the loop. Use that variable instead of the expression, in the loop (2 places that I can see)

Create another variable and assign today() to it outside the loop. Use .Cells(i, 18).Value + <That Variable> in the comparison. If you don't think this macro's execution will span across midnight, you can use today() directly instead of using a variable.

Upvotes: 0

Related Questions