How to Find and Insert Rows for Missing Timestamps, Remove rows for Unwanted Timestamps

How to find and insert rows for missing timestamps, remove rows for unwanted timestamps

Requirement:

The user has a huge table containing about 24000 rows of 800 hours of data, where each cell has an interval of 2 minutes.

The sample values in table are:

station	date	used	free
1	5/21/2008 12:00	6	15
1	5/21/2008 12:02	7	14
1	5/21/2008 12:04	6	15
1	5/21/2008 12:08	5	16
1	5/21/2008 12:14	6	15
1	5/21/2008 12:15	7	14
1	5/21/2008 12:16	7	14

In the above table, time-stamps for 12:06, 12:10 and 12:12 are missing, while 12:15 should not be there, because every interval should be of 2 minutes.

The user has tried the following code provided by rbrhodes at the following link:
https://www.ozgrid.com/forum/forum/h...tes-times-list

Code:

Option Explicit

Sub rowinsert()

Dim ThisTime As Double
Dim NextTime As Double
Dim cel As Range
Dim rng As Range
Dim LastRow As Long
Dim rval As Variant

'Speed
Application.ScreenUpdating = False

'Get last row of data
LastRow = Range("B" & Rows.Count).End(xlUp).Row

'Where to look
Set rng = Range("B1:B" & LastRow)

'Chek all
For Each cel In rng
'Check if done
If cel.Offset(1, 0) = vbNullString Then GoTo endo
'Add 15 mins to cell value
ThisTime = Round((cel + TimeValue("00:02:00")) * 24 * 30) / 30 / 24
'Get next cel time
NextTime = Round(cel.Offset(1, 0) * 24 * 30) / 30 / 24
'Check if toime is + 15
If ThisTime <> NextTime Then
'No. Insert a row
cel.Offset(1, 0).EntireRow.Insert shift:=xlDown
'Put next req'd time
cel.Offset(1, 0) = ThisTime
'Put 'N/A'
Range(cel.Offset(1, 1), cel.Offset(1, 2)) = "N/A"
End If
Next

endo:

'Cleanup
Set cel = Nothing
Set rng = Nothing

'Reset
Application.ScreenUpdating = True

End Sub

It is working perfectly fine for missing values. but if there are timestamps in sequence like 12:14, 12:15, 12:16, then that code is not working.

The user needs to modify the code to delete the rows which contains "odd" timestamps.

https://www.ozgrid.com/forum/forum/help-forums/excel-vba-macros/1195629-find-and-insert-rows-for-missing-timestamps-remove-rows-for-unwanted-timestamps

Solution:

ode:

Sub TimeCleanup()
    Dim x, y(), z, fmt, i As Long, ii As Long, iii As Long, dtS As Date, dtE As Date

    x = ActiveSheet.Cells(1).CurrentRegion ' Load all original data into array x

'// set array z to be a 1 dimensional array with its upper limit the same as array x 1st dimension upper limit.

    ReDim z(1 To UBound(x, 1))

'// variales dtS and dtE are the start and end date/time values of the original data
'   the start time will be the first time in array x and the end time the last - so if either/both is/are
'   between 12AM and 5AM then dtS will need to be 05:02 for start and dtE 23:58 for end, with the correct date(s).

    dtS = x(1, 2): dtE = x(UBound(x, 1), 2)

'// variable fmt is the date formatting of the original data and is used to ensure formatting of new data matches original

    fmt = ActiveSheet.Cells(1, 2).NumberFormat

'// set the starting dimension sizes for array y and add the starting station and  date/time

    ReDim y(1 To UBound(x, 2), 1 To 1)
    y(1, 1) = x(1, 1): y(2, 1) = Format(dtS, fmt)

'// this section of code increases the 2nd dimension size of array y and adds every date/time from start date/time to last with 2 minute intervals.

    Do While CDbl(CDate(y(2, UBound(y, 2)))) < CDbl(dtE)
        ReDim Preserve y(1 To UBound(x, 2), 1 To UBound(y, 2) + 1)
        y(2, UBound(y, 2)) = Format(DateAdd("n", 2, y(2, UBound(y, 2) - 1)), fmt)
    Loop

'// array z is loaded with all the date/times in original data

    For i = 1 To UBound(x, 1)
        z(i) = CStr(Format(x(i, 2), fmt))
    Next

'// loop through all the date/times in array y and check if each date/time is in array z (original data date/times)

    For i = 1 To UBound(y, 2)
        If Not IsError(Application.Match(y(2, i), z, 0)) Then 'date/time matches
            ii = Application.Match(y(2, i), z, 0) 'get the index in array z of the matching date/time
            For iii = 1 To UBound(x, 2) ' load array y with original data for matching date/time
                y(iii, i) = x(ii, iii)
                If iii = 2 Then y(iii, i) = Format(y(iii, i), fmt)
            Next
        ElseIf i > 1 Then 'no match found so add the station from previous matching date/time - Note this is where you will need to add "Used" and "Free"
            y(1, i) = y(1, i - 1)
        End If
    Next

'// the contents of array y replace the original data, then the table is formatted as per original formatting

    Application.ScreenUpdating = 0
    With ActiveSheet
        .Cells(1).CurrentRegion.ClearContents
        .[a1].Resize(UBound(y, 2), UBound(y, 1)) = Application.Transpose(y)
        With .Cells(1).CurrentRegion
            .Columns(2).NumberFormat = fmt
            .Columns(1).HorizontalAlignment = .Columns(1).Rows(1).HorizontalAlignment
            .Columns(3).Resize(, 2).HorizontalAlignment = .Columns(1).Rows(1).HorizontalAlignment
        End With
    End With

End Sub

Obtained from the OzGrid Help Forum.

Solution provided by KjBox.