Determine difference in time

Hello,
I’m using VBA to run a code for an excel spreadsheet. My spreadsheet has four columns (DATE, TIME, USER, ACTION) and about 400 rows.

I’d like my code to determine if there was less than 4 minutes between actions for a user. If it determines that this is true, then all of the text in the “older time” in those 4 columns making up that row should change to red.

EXAMPLE:
(1) 9/30/14 21:56 32 IN
(2) 9/29/14 20:45 28 IN
(3) 9/29/14 20:44 28 IN
(4) 9/28/14 19:12 31 IN
(5) 9/28/14 19:10 27 IN
(6) 9/27/14 12:36 28 IN
(7) 9/26/14 12:34 28 IN

-Row 3 should change to red text in that row because the time difference is less than 4 minutes and it is the same user (#28) and it is the ‘older’ time

-Row 5 does not change to red text – even though the time difference is less than 4 minutes, they are not the same user

-Row 7 does not change to red text – even though the time difference is less than 4 minutes, and it is the same user, the action occurred on a different day

Any help and shared expertise would be greatly appreciated! Thank you!

Hi lacke81c and welcome to ExcelForum,

When I tested the following macro, the data started in cell "A1" (date).

Option Explicit

Sub ProcessItemsFromAList()

  Const nFileListHeaderROW = 0
  Const FourMinutesWorthOfSEONDS = 4 * 60
  
  Dim wb As Workbook
  Dim ws As Worksheet

  Dim myDeltaSeconds As Long
  Dim myDate As Date
  Dim myTime As Date
  Dim myDateAndTime As Date
  Dim myDateAndTimePrevious As Date

  Dim iCount As Long
  Dim iError As Long
  Dim iErrorCount As Long
  Dim iOutputRow As Long
  Dim iRow As Long
  
  Dim bNeedMore As Boolean
  
  Dim sAction As String
  Dim sDate As String
  Dim sTime As String
  Dim sUser As String
  Dim sUserPrevious As String
  
  Set wb = ThisWorkbook
  Set ws = wb.ActiveSheet
  
  
  'Initialize the Source Row
  iRow = nFileListHeaderROW

  
  'Loop until all matching files have been found
  bNeedMore = True
  While bNeedMore
    'Debug.Print sPath & sFileName
    
    'Increment the source row number
    iRow = iRow + 1
    
    'Get the data from the Row
    sDate = ws.Cells(iRow, "A").Text
   
    'Terminate if 'File Name' is blank
    If Len(sDate) = 0 Then
      bNeedMore = False
    Else
   
      myDate = 0
      myTime = 0
      myDateAndTime = 0
      sTime = ws.Cells(iRow, "B").Text
      sUser = ws.Cells(iRow, "C").Text
      sAction = ws.Cells(iRow, "D").Text
      
      If IsDate(sDate) Then
        myDate = CDate(sDate)
      End If
    
      If IsDate(sTime) Then
        myTime = CDate(sTime)
      End If
    
      myDateAndTime = myDate + myTime
    
      Debug.Print iRow, myDateAndTime, sUser  'Write to Debugger Immediate Window (CTRL G)
      
      If sUser = sUserPrevious Then
      
        myDeltaSeconds = DateDiff("s", myDateAndTime, myDateAndTimePrevious)
        Debug.Print "---------", myDeltaSeconds
        If myDeltaSeconds < FourMinutesWorthOfSEONDS Then
          Debug.Print "RED"
          ws.Cells(iRow, "A").Interior.Color = RGB(255, 0, 0) 'Red
          ws.Cells(iRow, "B").Interior.Color = RGB(255, 0, 0) 'Red
          ws.Cells(iRow, "C").Interior.Color = RGB(255, 0, 0) 'Red
          ws.Cells(iRow, "D").Interior.Color = RGB(255, 0, 0) 'Red
        End If
        
      End If
      
      myDateAndTimePrevious = myDateAndTime
      sUserPrevious = sUser
    End If
      
  Wend
  
  'Clear object pointers
  Set wb = Nothing
  Set ws = Nothing
  
End Sub

Lewis

Thank you LJMetzger !

It is working perfectly