Calculate stop time, runtime etc. with Excel VBA macros

On the page Calculating time I show various ways to calculate time using date and string functions.

This page shows a sample macro for calculating number of stops, starts, stop time, runtime, meantime between stops and more. Stuff that is often used to measure process efficiency.

Being able to calculate time is useful, and by doing it in Excel you can tailor it the way you like. You just need to get the times etc. into an Excel spreadsheet - e.g. by importing a CSV-file.

The example on this page uses the VBA function DateDiff to calculate the time differences, and it also uses loops, ranges, arrays and a collection.

You can download a spreadsheet (zip compressed and Excel 2003) with the example here, or you can copy the code below into a VBA module.

In the example the "log" is a simple table with 3 columns. The oldest entry/post is at the top, and I have made it future-proof by using the year 2020. Smiley

There can be more columns, the order can be different, there can be more motors or production lines - this is just a simple example.

In cell G2 and down you must write the name of the motor(s) in question (here MOTOR1 and/or MOTOR2).

For each motor the macro will find the total number of stops, number of starts, total stop time, total runtime, meantime between stops and the total time from the first to the last row.

To calculate the time difference in seconds the macro uses the DateDiff function:

The macro has 3 nested loops. The outer loop loops the log for each motor in cell G2 and down. If there is only 1 motor, there will be just one loop.

The inner loop loops the rows from the top until the cell in column A matches the motor and the status in column C is "STOP".

When that happens, we start a new loop downwards, until there is a motor match and the status in column C is "START".

As we go along, the macro counts the number of stops and starts. At the end seconds are converted to hours, and a table (or tables) is copied to Sheet2.

For faster execution we copy the table with log data into an array with the same dimensions. One could use the table range instead, but it is faster to operate on an array.

Sub Calculate()
Dim bStart As Boolean         'Flag for start
Dim bStop As Boolean          'Flag for stop
Dim rCell As Range            'Range variable
Dim rTable As Range           'The table with log data
Dim arInput()                 'The array with log data
Dim lCount As Long            'Counter
Dim lRow As Long              'Counter
Dim lRow2 As Long             'Counter
Dim lDualStart As Long        'Counts starts with no stop
Dim lDualStop As Long         'Counts stops with no start
Dim lLastRow As Long          'Number of rows in array/table
Dim lTimeDiff As Long         'Time difference between stop/start
Dim lStarts As Long           'Number of starts
Dim lStops As Long            'Number of stops
Dim lTotaltime As Long        'Time between first and last post
Dim dStopTime As Double       'Total stop time
Dim colMotor As New Collection 'Collection for motor names

On Error GoTo ErrorHandle

Worksheets(1).Activate

'The table's first row
Set rTable = Range("A2", Range("A2").End(xlToRight))

If Len(Range("A3").Value) = 0 Then
   MsgBox "There is only one row in the table."
   GoTo BeforeExit
End If

'Expand rTable
Set rTable = Range(rTable, rTable.End(xlDown))

'Copy the table to the array. We do this,
'because it is faster to operate on an array.
'The array automatically gets the same
'dimensions as the table.
arInput = rTable.Value

'First motor name
Set rTable = Range("G2")

If Len(rTable.Value) = 0 Then
   MsgBox "Cell G2 and down must hold the name(s) of the motor(s)."
   GoTo BeforeExit
End If

'If there is more than one motor,
'we expand rTable.
If Len(rTable.Offset(1, 0).Value) > 0 Then
   Set rTable = Range(rTable, rTable.End(xlDown))
End If

'To ensure unique items only, we add the motors
'to a collection. Trying to add a duplicate key
'to a collection triggers an error, and that
'is why we write: On Error Resume Next
'Using a collection is not necessary - you could
'just loop the range instead, but I have used
'the collection just to show how you can avoid duplicates.
On Error Resume Next

For Each rCell In rTable
   colMotor.Add rCell.Value
Next

On Error GoTo ErrorHandle

'For convenience we store the number
'of rows in a variable.
lLastRow = UBound(arInput)

'We calculate the total number of seconds from
'the first to the last entry.
lTotaltime = DateDiff("s", arInput(1, 2), arInput(lLastRow, 2))

'Now we loop through the motor collection and loop the
'array once for each motor. The oldest entry in the
'array is at the top, so we look from 1st to last row.
With colMotor
   'Loop through the collection
   For lCount = 1 To .Count
      lStarts = 0
      lStops = 0
      dStopTime = 0
      lDualStop = 0
      lDualStart = 0
      
      'Inner loop through the rows
      For lRow = 1 To lLastRow
         'If the motor in the first column
         'matches the motor we are looking for
         If arInput(lRow, 1) = .Item(lCount) Then
            'If it is started before we have a stop entry,
            'it must have been stopped until now, and the
            'stop time from 1st row to present is calculated
            If arInput(lRow, 3) = "START" And lStops = 0 Then
               bStart = True
               lStops = 1
               lStarts = 1
               'If it isn't the first row, we calculate
               'the stop time from 1st row
               If lRow > 1 Then
                  lTimeDiff = DateDiff("s", arInput(lRow, 2), arInput(1, 2))
                  dStopTime = lTimeDiff
               End If
            End If
            'If bStart is TRUE and there is a new start,
            'the stop in between wasn't logged, and since
            'this makes the calculation of stop time etc.
            'unreliable, we increment lDualStart.
            If arInput(lRow, 3) = "START" And bStart Then
               lDualStart = lDualStart + 1
               lStarts = lStarts + 1
            End If
            'If the motor was stopped
            If arInput(lRow, 3) = "STOP" Then
               bStop = True   'Set flag
               bStart = False 'Set flag
               'Increment total number of stops
               lStops = lStops + 1
               
               'Inner loop forward to find the start time
               For lRow2 = lRow + 1 To lLastRow
                  'If the motor was started
                  If arInput(lRow2, 3) = "START" And _
                  arInput(lRow2, 1) = .Item(lCount) Then
                     'We calculate the stop time
                     lTimeDiff = DateDiff("s", arInput(lRow, 2), _
                     arInput(lRow2, 2))
                     'Add it to the total stop time
                     dStopTime = dStopTime + lTimeDiff
                     'lRow is set = lRow2 to jump forward
                     lRow = lRow2
                     bStop = False  'Flag
                     bStart = True  'Flag
                     'Increment starts
                     lStarts = lStarts + 1
                     'Exit the inner loop
                     Exit For
                  End If
                  'If we encounter yet another STOP, there has
                  'been an unlogged start, and we increment lDualStop.
                  If arInput(lRow2, 3) = "STOP" And _
                  arInput(lRow2, 1) = .Item(lCount) Then
                     lDualStop = lDualStop + 1
                  End If
                  'If we get to the last row without finding a start,
                  'the motor was still stopped when the last entry was
                  'logged, so we add the stop time from the last stop
                  'to the last entry.
                  If lRow2 = lLastRow And bStart = False And bStop Then
                     lTimeDiff = DateDiff("s", arInput(lRow, 2), _
                     arInput(lLastRow, 2))
                     dStopTime = dStopTime + lTimeDiff
                  End If
               Next
            
            End If
         End If
      Next
      
      'Call WriteResult to write a
      'small table with our findings.
      WriteResult lStops, lStarts, dStopTime, _
      lTotaltime, lCount, .Item(lCount)
      If lDualStart > 0 Then
         If lDualStart = 1 Then
            MsgBox "There are 2 START logs with no stop in between." _
            & vbNewLine & _
            "The calculated times for " & .Item(lCount) & " are unreliable."
         Else
            MsgBox "There are " & lDualStart * 2 & _
            " START logs with no stops in between." _
            & vbNewLine & _
            "The calculated times for " & .Item(lCount) & " are unreliable."
         End If
      End If
      If lDualStop > 0 Then
         If lDualStop = 1 Then
            MsgBox "There are 2 STOP logs with no start in between." _
            & vbNewLine & _
            "The calculated times for " & .Item(lCount) & " are unreliable."
         Else
            MsgBox "There are " & lDualStop * 2 & _
            " STOP logs with no start in between." & vbNewLine & _
            "The calculated times for " & .Item(lCount) & " are unreliable."
         End If
      End If
   Next
End With

BeforeExit:
On Error Resume Next
Erase arInput
Set colMotor = Nothing
Set rTable = Nothing
Set rCell = Nothing

Exit Sub
ErrorHandle:
MsgBox Err.Description & " Procedure Calculate"
Resume BeforeExit
End Sub

Sub WriteResult(ByVal lStops As Long, ByVal lStarts As Long, _
ByVal dStopTime As Double, ByVal lTotaltime As Long, _
ByVal lCount As Long, ByVal sMotor As String)
'Writes a table with stoptime etc. to sheet 2
'Seconds are converted to hours.

Dim arOutput(1 To 6, 1 To 3)  'Array for output table
Dim rInsert As Range          'Range for table
Dim lStep As Long
Dim lRow As Long

On Error GoTo ErrorHandle

Application.ScreenUpdating = False

arOutput(1, 1) = "Stops " & sMotor
arOutput(2, 1) = "Starts " & sMotor
arOutput(3, 1) = "Total stoptime"
arOutput(4, 1) = "Total runtime"
arOutput(5, 1) = "Meantime between stops"
arOutput(6, 1) = "Total time logged"

arOutput(1, 2) = lStops
arOutput(2, 2) = lStarts
arOutput(3, 2) = dStopTime / 3600
arOutput(4, 2) = (lTotaltime - dStopTime) / 3600
arOutput(5, 2) = lTotaltime / 3600 / lStops
arOutput(6, 2) = lTotaltime / 3600

arOutput(3, 3) = "Hours"
arOutput(4, 3) = "Hours"
arOutput(5, 3) = "Hours"
arOutput(6, 3) = "Hours"

Worksheets(2).Activate

'If it is the first motor in the collection,
'we start in range A1, else we find the
'start cell for the table further down.
If lCount = 1 Then
   Cells.ClearContents
   Set rInsert = Range("A1")
Else
   For lStep = 1 To lCount
      lRow = lStep + 6
   Next
   Set rInsert = Range("A" & lRow)
End If

'Define the table's range
Set rInsert = Range(rInsert, rInsert.Offset(5, 2))

'Copy the array values to the range
rInsert.Value = arOutput

BeforeExit:
On Error Resume Next
Erase arOutput
Set rInsert = Nothing
Application.ScreenUpdating = True

Exit Sub
ErrorHandle:
MsgBox Err.Description & " Procedure WriteResult"
Resume BeforeExit
End Sub

That was it - a sample macro with conditions for calculating time. You can easily change or add things and tailor it to your needs. For instance you can ignore stops that are below 3 minutes.

Calculate stop time, runtime etc. with VBA