Calculate Maximum Time Difference Within a Time Period with Max 30 Minutes Difference

Question

For ease of Reference, Sample Data Set which needs to be pasted into Column C from row 20. You can paste the text below into word and then copy from word into Excel with the Cell format set to Custom: yyyy/mm/dd hh:mm:ss.000

2015/08/01 12:53:03.000
2015/08/01 12:56:31.101
2015/08/01 12:56:37.499
2015/08/01 13:00:05.901
2015/08/01 13:00:12.300
2015/08/01 13:03:38.700
2015/08/01 13:03:45.101
2015/08/01 13:05:51.702
2015/08/01 17:39:57.520
2015/08/01 17:40:39.120
2015/08/02 17:39:39.225
2015/08/02 17:40:06.423
2015/08/03 06:39:59.277
2015/08/03 06:41:04.877
2015/08/03 15:31:18.520
2015/08/03 15:32:49.119
2015/08/04 05:15:04.593
2015/08/04 05:17:34.392

My script's function is to insert 2 columns to the right of Column C.
Then to check the values in Column C from Row 20 and evaluate which values are within 30 Minutes from the First Sample point.

I then merge all the relevant cells in the each Column of the additional two Columns, which were created, and insert the date (Day) and time difference in mm:ss.000 from the first time to the last time of that time period. It then iterates over the entire data set.

I have already reduced the complexity of the script form my original code and would like to see what I could have done better.

NOTE I have purposefully added a ' to remove the Application. lines while I have been testing the code.

Option Explicit
Public Declare Function GetTickCount Lib "kernel32.dll" () As Long

Sub CountMaximumTimeDifferenceWithin30Minutes()

    Dim t As Long
    Dim tt As Long
    Dim DataFileFullPath As String, DataFileName As String, SheetName As String
    Dim Index As Long, Index2 As Long
    Dim DataWorkSheet As Worksheet
    Dim columnIndex As Long
    Dim firstRow As Long, lastRow As Long
    Dim row As Long, col As Long
    Dim i As Long
    Dim CurrentRowPlus30Mins As Date, checkCell As Date, TDiff As Date
    Dim NextCell As Date
    Dim OneTimePeriod As Range

'    'Disable Screen Updating
'    Application.ScreenUpdating = False
'    Application.Calculation = xlCalculationManual

    'Paste Full Path to your demo/test ExcelBook here
    DataFileFullPath = "C:\Users\.................."

    Index = InStrRev(DataFileFullPath, "\")
    DataFileName = Right(DataFileFullPath, Len(DataFileFullPath) - Index)

    Index2 = InStrRev(DataFileName, ".")
    SheetName = Left(DataFileName, Index2 - 1)

    t = GetTickCount

    Set DataWorkSheet = Workbooks(DataFileName).Sheets(SheetName)

    columnIndex = 3 '/ Column "C"
    firstRow = 20

    lastRow = DataWorkSheet.Cells(DataWorkSheet.Rows.Count, columnIndex).End(xlUp).row

    With DataWorkSheet
        .Columns(columnIndex + 1).Insert Shift:=xlToRight
        .Columns(columnIndex + 1).Insert Shift:=xlToRight
        .Columns(columnIndex + 1).NumberFormat = "yyyy/mm/dd"
        .Columns(columnIndex + 2).NumberFormat = "mm:ss.000"
    End With



    For row = firstRow To lastRow

        CurrentRowPlus30Mins = DataWorkSheet.Cells(row, columnIndex).Value + TimeSerial(Hour:=0, Minute:=30, Second:=0)

        checkCell = DataWorkSheet.Cells(row, columnIndex).Value

        For i = 1 To 20

            NextCell = DataWorkSheet.Cells(row + i, columnIndex).Value

            If NextCell > CurrentRowPlus30Mins Or DataWorkSheet.Cells(row + i, columnIndex).Value = "" Then

                Set OneTimePeriod = DataWorkSheet.Range(Cells(row, columnIndex), Cells(row + i - 1, columnIndex))

                    With OneTimePeriod

                        .Offset(, 2).Merge
                        .Offset(, 2).Value = Application.WorksheetFunction.Max(OneTimePeriod) - Application.WorksheetFunction.Min(OneTimePeriod)
                        .Offset(, 1).Merge
                        .Offset(, 1).Value = OneTimePeriod.Cells(1)

                    End With

                    'Minus 1 to cater for the Next row increment
                    row = row + i - 1

                    Exit For
            End If
        Next i
    Next row

'    'Enable Screen Updating
'    Application.ScreenUpdating = True
'    Application.Calculation = xlCalculationAutomatic


    tt = GetTickCount - t
End Sub

Answer 1

The first thing I'd say is your variable names could be improved -

• what is t? BeginningTicketCount?
• what is tt? EndingTicketCount?
• Index and Index2 - I'd avoid Index as system reserved and I'd avoid any variable with a number in its name. If you need a variable with a number it means either you don't need that variable or your variable names aren't descriptive enough.
• You did well with firstRow and lastRow, but row is reserved by the system and col isn't great. You should give them meaningful names. XaxisLocation, YaxisLocation
• What is i for?
• The CurrentRowPlus30Mins has a number in it, but to each his own.

Otherwise, it looks like it's a pretty solid method to me. I'd suggest adding some comments within the code blocks to describe why something is happening so it doesn't leave the reader guessing. E.g.

 'Finding the start of the file name by looking for the first [...]
 Index = InStrRev(DataFileFullPath, "\")
 DataFileName = Right(DataFileFullPath, Len(DataFileFullPath) - Index)