Stumped on macro to add rows

[scott1588]

I really don't know what to make of this...

I have a list of thousands of dates and times in chronological order. Here is a short example:

9/14/09 15:08:00
9/14/09 15:09:00
9/14/09 15:12:00
9/14/09 15:13:00
9/14/09 15:15:00
9/15/09 9:09:00
9/15/09 9:10:00
9/15/09 9:11:00
9/15/09 9:13:00
9/15/09 9:14:00
9/15/09 9:16:00
9/15/09 9:17:00

Note that there are minutes missing and the dates change. I need to fill in the missing minutes for each date but not the minutes between dates. Here is an example of what I need for my result based on the above example (added dates indicated with * for clarity)

9/14/09 15:08:00
9/14/09 15:09:00
9/14/09 15:10:00*
9/14/09 15:11:00*
9/14/09 15:12:00
9/14/09 15:13:00
9/14/09 15:14:00*
9/14/09 15:15:00
9/15/09 9:09:00
9/15/09 9:10:00
9/15/09 9:11:00
9/15/09 9:12:00*
9/15/09 9:13:00
9/15/09 9:14:00
9/15/09 9:15:00*
9/15/09 9:16:00
9/15/09 9:17:00

So I have written a macro that starts from the bottom of the list and checks to see if the time in the cell above is the next minute. If not, the macro inserts a row and adds the missing time (ideally in red text but I haven't gotten that far yet). The idea is that I work my way up adding the missing minutes. If the date changes, the information is reset to the new date and time and the process continues.

Here is the code...

Sub AddRow()
'
' AddRow Macro
' Macro recorded 11/1/2009 by Scott Evans
'

'
Dim vDate As Single
Dim vTime As Date
Dim inc_min As Date

inc_min = 0.00069444444
vDate = Int(ActiveCell.Value)
vTime = ActiveCell.Value - inc_min

Do Until IsEmpty(ActiveCell)

'Checks date and resets info
If Int(ActiveCell.Offset(-1, 0).Value) <> vDate Then
vDate = Int(ActiveCell.Value)
vTime = ActiveCell.Value
End If

'Checks in next minute is as expected if not, add row
If ActiveCell.Offset(-1, 0).Value <> vTime Then
Selection.EntireRow.Insert
ActiveCell.Value = vTime
vTime = vTime - inc_min
End If

vTime = vTime - inc_min
ActiveCell.Offset(-1, 0).Range("A1").Select

Loop

End Sub

So I have this really strange problem with the IF/THEN loop that inserts the row. On the dataset above, it works fine the first time through. But after it encounters its first missing minutes, the IF/THEN loop is always triggered even if the values are equal!!

I am totally stumped. I tried dimensioning the variables differently, I tried using the exact value for the min_inc variable (60/86400) since the result is irrational. I can't figure out why the IF/THEN loop is triggered.

If anyone can provide some help on this one, it would be greatly appreciated.

 

[PCL]

Assuming data is in column A.
Perhaps next code

Option Explicit
Sub Inser_Row()
Dim LastRow As Long
Dim I As Long, J As Long
Dim NbMN As Integer, NbDAY As Integer
Dim A, B
    Application.ScreenUpdating = False
    LastRow = Range("A" & Rows.Count).End(xlUp).Row
    For I = LastRow To 2 Step -1
        NbMN = Minute(Cells(I, "A")) - Minute(Cells(I - 1, "A"))
        NbDAY = Day(Cells(I, "A")) - Day(Cells(I - 1, "A"))
        If (NbDAY = 0) Then
            If (NbMN >= 2) Then
                For J = 1 To NbMN - 1
                   Rows(I).EntireRow.Insert
                   Cells(I, "A") = Cells(I + J, "A") - J / 24 / 60
                Next J
            End If
        End If
    Next I
    Application.ScreenUpdating = True
End Sub

It can be improved on the time issue if there is a lot of rows

 

[scott1588]

PCL,

This is absolutely amazing. It works like a charm.

Thanks so much. You have helped me a great deal.

 

[facethegod]

Also..

Option Explicit
Sub tst()
Dim ii  As Single, i%
Const MinDiff% = 1440
Application.ScreenUpdating = False
With Cells(1, 1).Resize(Cells(Rows.Count, 1).End(xlUp).Row, 1)
    For i = .Rows.Count To 2 Step -1
        If Int(.Item(i, 1)) = Int(.Item(i - 1, 1)) Then
            ii = .Item(i, 1) - .Item(i - 1, 1)
            ii = Evaluate("Mod(" & ii & ",1)"): ii = Int(ii * MinDiff)
            If ii > 1 Then
                With .Item(i, 1).Resize(ii - 1)
                    .EntireRow.Insert
                    .Offset(-ii + 1).FormulaR1C1 = "=R[-1]C+1/" & MinDiff
                End With
            End If
        End If
    Next
End With
Application.ScreenUpdating = True
End Sub

Hope it helps

 

[scott1588]

PCL...

Whoops. I noticed a problem and I'm not sure how to fix it in the code you provided. If the hour changes in the middle of the missing minutes, the code does not fill in the missing minutes.

Do you have any idea how to address this?

FaceTheGod...
Thanks so much for your code. I'm looking it over now. I appreciate the time you put it on this for me.

 

[PCL]

Other run

Sub Inser_Row1()
Dim LastRow As Long
Dim I As Long, J As Long
Dim NbMN As Integer, NbHR As Integer, NbDAY As Integer
Dim A, B
    Application.ScreenUpdating = False
    LastRow = Range("A" & Rows.Count).End(xlUp).Row
    For I = LastRow To 2 Step -1
        NbDAY = Day(Cells(I, "A")) - Day(Cells(I - 1, "A"))
        NbHR = Hour(Cells(I, "A")) - Hour(Cells(I - 1, "A"))
        NbMN = Minute(Cells(I, "A")) - Minute(Cells(I - 1, "A"))
        NbMN = NbHR * 60 + NbMN
        If (NbDAY = 0) Then
            If (NbMN >= 2) Then
                For J = 1 To NbMN - 1
                   Rows(I).EntireRow.Insert
                   Cells(I, "A") = Cells(I + J, "A") - J / 24 / 60
                Next J
            End If
        End If
    Next I
    Application.ScreenUpdating = True
End Sub