Macro to insert rows

[bradyj7]

Hi there,

In column A I have time values as in the example below. You'll see that they are every 2-5 secs approximately. The number of rows varies considerably in each workbook depending on how long the recording lasted. I'm looking for a macro that will find the last row of data in Col A and insert rows between the ones that are there so that there is a row for every second.

 Date 
28/03/2011 08:08:23
28/03/2011 08:08:26
28/03/2011 08:08:31
28/03/2011 08:08:37
28/03/2011 08:08:41
28/03/2011 08:08:47
28/03/2011 08:08:51

So as an example I'd like it to do this

28/03/2011 08:08:23
28/03/2011 08:08:24
28/03/2011 08:08:25
28/03/2011 08:08:26
etc

Appreciate any ideas

Thanks

John

 

[jvanbonn]

Do the recordings ever span multiple days?

Does Column A contain both date & time?

 

[craig.penny]

Try this

Sub GoodTimes()
Dim i As Long, j As Long
Dim FR As Long: FR = 1
Dim LR As Long: LR = ActiveSheet.Range("A" & ActiveSheet.Rows.Count).End(xlUp).Row
Dim Str As String
Dim Tm1 As Date
Dim Tm2 As Date
Dim Tm3 As Integer
Dim Dif As Double
Dif = 1 / 24 / 60 / 60
For i = LR To (FR + 1) Step -1
      Tm1 = Cells(i - 1, 1)
      Tm2 = Cells(i, 1)
      Tm3 = DateDiff("s", Tm1, Tm2)
      
      If Tm3 > 1 Then
            For j = (Tm3 - 1) To 1 Step -1
                  Rows(i).Insert Shift:=xlDown
                  Cells(i, 1) = Tm1 + (Dif * j)
                  Cells(i, 1).NumberFormat = "dd/mm/yyyy hh:mm:ss"
            Next j
      End If
Next i
End Sub

 

[bradyj7]

Hi,

Thanks for the macro above. I call it in inside another macro.

It works in as so far that it inserts the rows in the appropriate areas but when it gets to the end of column its crashes with a "type mismatch" error on this line and doesn't continue on with the rest of the bigger macro.

 Tm1 = Cells(i - 1, 1)

Would you know why this is happening?

Thank you

 

[bradyj7]

Sorry, its obvious why - The first row has a heading in it, Just had to change Fr=2

Thanks

 

[craig.penny]

I copied what you posted

 Date 
28/03/2011 08:08:23
28/03/2011 08:08:26
28/03/2011 08:08:31
28/03/2011 08:08:37
28/03/2011 08:08:41
28/03/2011 08:08:47
28/03/2011 08:08:51


</PRE>

and pasted into my worksheet. The code I posted worked on it fine but I assumed you had already formatted the entire column as date. What you posted was all in one column right? It's not column A: 28/03/2011 and column B: 08:08:23 is it?

 

[craig.penny]

So it's working okay then?

 

[bradyj7]

Yes, its works fine thanks alot. But thats actually only have of the problem. I've started a new thread to try get the other bit done. I probably should of kept it all as one. Here it is anyway http://www.mrexcel.com/forum/showthread.php?p=2675387#post2675387

 

[craig.penny]

Sub GoodTimes()
Dim i As Long, j As Long
Dim FR As Long: FR = 1
Dim LR As Long: LR = ActiveSheet.Range("A" & ActiveSheet.Rows.Count).End(xlUp).Row
Dim Str As String
Dim Tm1 As Date
Dim Tm2 As Date
Dim Tm3 As Integer
Dim Dif As Double
Dim Val1 As Single
Dim Val2 As Single
Dim Val3 As Single
Dif = 1 / 24 / 60 / 60
For i = LR To (FR + 1) Step -1
      Tm1 = Cells(i - 1, 1)
      Tm2 = Cells(i, 1)
      Tm3 = DateDiff("s", Tm1, Tm2)
      Val1 = CSng(Cells(i - 1, 2))
      Val2 = CSng(Cells(i, 2))
      Val3 = (Val2 - Val1) / Tm3
      
      If Tm3 > 1 Then
            For j = (Tm3 - 1) To 1 Step -1
                  Rows(i).Insert Shift:=xlDown
                  Cells(i, 1) = Tm1 + (Dif * j)
                  Cells(i, 1).NumberFormat = "dd/mm/yyyy h:mm:ss"
                  Cells(i, 2) = Val1 + j * Val3
            Next j
      End If
Next i
End Sub

Let me know if it works.

 

[bradyj7]

Hi,

That works absolutely perfect!

Thanks a million