Add rows between time frames

Vuko32

New Member
Joined
Jan 18, 2019
Messages
3
Hi all,

i have device that records some data (Rain Gauge). Device works like this: if there is rain, it records intensity, and it writes it to that minute. After last activity it also writes five more datas that are zero.
My main problem is that a don't know how to write formula, or script to add rows between last zero value and first next value. I have data for thousands of rows, so manual work is a no go.
For example, this is my data:

K2_podaci_test.xlsx
ABC
1date time [mm/T]
220.11.20204:07:000,1
320.11.20204:08:000
420.11.20204:09:000
520.11.20204:10:000
620.11.20204:11:000
720.11.20204:12:000
820.11.20204:22:000,1
920.11.20204:23:000
1020.11.20204:24:000
1120.11.20204:25:000
1220.11.20204:26:000
1320.11.20204:27:000
1420.11.20204:40:000,1
1520.11.20204:41:000
1620.11.20204:42:000
1720.11.20204:43:000
1820.11.20204:44:000
1920.11.20204:45:000
2020.11.20204:51:000,1
2120.11.20204:52:000
2220.11.20204:53:000
2320.11.20204:54:000
2420.11.20204:55:000
2520.11.20204:56:000
List1


And now i want to add 9 rows between 4:12 and 4:22. Also 12 rows between 4:27 to 4:40, and so on to look like this:

K2_podaci_test.xlsx
ABC
1date time [mm/T]
220.11.20204:07:000,1
320.11.20204:08:000
420.11.20204:09:000
520.11.20204:10:000
620.11.20204:11:000
720.11.20204:12:000
8
9
10
11
12
13
14
15
16
1720.11.20204:22:000,1
1820.11.20204:23:000
1920.11.20204:24:000
2020.11.20204:25:000
2120.11.20204:26:000
2220.11.20204:27:000
23
24
25
26
27
28
29
30
31
32
33
34
3520.11.20204:40:000,1
3620.11.20204:41:000
3720.11.20204:42:000
3820.11.20204:43:000
3920.11.20204:44:000
4020.11.20204:45:000
4120.11.20204:51:000,1
4220.11.20204:52:000
4320.11.20204:53:000
4420.11.20204:54:000
4520.11.20204:55:000
4620.11.20204:56:000
List1


If this can be made, can you help me with next. When i add blank rows can i quickly fill blank times and date that it fits to data. And of course to add zero value to blank spots in C column.
It would look like this (yellow color is how data should be added):

K2_podaci_test.xlsx
ABC
1date time [mm/T]
220.11.20204:07:000,1
320.11.20204:08:000
420.11.20204:09:000
520.11.20204:10:000
620.11.20204:11:000
720.11.20204:12:000
820.11.20204:13:000
920.11.20204:14:000
1020.11.20204:15:000
1120.11.20204:16:000
1220.11.20204:17:000
1320.11.20204:18:000
1420.11.20204:19:000
1520.11.20204:20:000
1620.11.20204:21:000
1720.11.20204:22:000,1
1820.11.20204:23:000
1920.11.20204:24:000
2020.11.20204:25:000
2120.11.20204:26:000
2220.11.20204:27:000
2320.11.20204:28:000
2420.11.20204:29:000
2520.11.20204:30:000
2620.11.20204:31:000
2720.11.20204:32:000
2820.11.20204:33:000
2920.11.20204:34:000
3020.11.20204:35:000
3120.11.20204:36:000
3220.11.20204:37:000
3320.11.20204:38:000
3420.11.20204:39:000
3520.11.20204:40:000,1
3620.11.20204:41:000
3720.11.20204:42:000
3820.11.20204:43:000
3920.11.20204:44:000
4020.11.20204:45:000
List1


Thanks for help.
 

Some videos you may like

Excel Facts

Bring active cell back into view
Start at A1 and select to A9999 while writing a formula, you can't see A1 anymore. Press Ctrl+Backspace to bring active cell into view.

Dossfm0q

Banned User
Joined
Mar 9, 2009
Messages
570
Office Version
  1. 2019
Platform
  1. Windows
What about
VBA Code:
Sub Add_rows_between_time_frames()
Dim Sht As Worksheet
Dim Rng As Range
Dim R As Range

Set Sht = ActiveSheet
LstRw = Sht.Cells(Rows.Count, 2).End(xlUp).Row
Set Rng = Sht.Cells(2, 2).Resize(LstRw, 1)

    For Each R In Rng
        On Error Resume Next
        If IsNumeric(R.Value) Then
            If Minute(R.Value) = 12 And Minute(R.Offset(1, 0).Value) = 22 Then
            Rows(R.Row + 1 & ":" & R.Row + 9).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
            ElseIf Minute(R.Value) = 27 And Minute(R.Offset(1, 0).Value) = 40 Then
            Rows(R.Row + 1 & ":" & R.Row + 12).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
            End If
        End If
    
    Next

End Sub
 

JLGWhiz

Well-known Member
Joined
Feb 7, 2012
Messages
12,979
Office Version
  1. 2013
Platform
  1. Windows
Another

VBA Code:
Sub tz()
Dim i As Long, r As Long
    With ActiveSheet
        For i = .Cells(Rows.Count, 3).End(xlUp).Row To 3 Step -1
            If .Cells(i, 3) <> 0 And .Cells(i - 1, 3) = 0 Then
                r = Round((.Cells(i, 2).Value - .Cells(i - 1, 2).Value) * 1440)
                .Rows(i).Resize(r).Insert
                .Cells(i, 2).Resize(r).Formula = "=B" & i - 1 & "+(1/1440)"
                .Cells(i, 1).Resize(r) = .Cells(i - 1, 1).Value
                .Cells(i, 3).Resize(r) = 0
            End If
        Next
    End With
End Sub
 

Dossfm0q

Banned User
Joined
Mar 9, 2009
Messages
570
Office Version
  1. 2019
Platform
  1. Windows
What About



VBA Code:
Sub Add_rows_between_time_frames_With_Fill()
Dim Sht As Worksheet
Dim Rng As Range
Dim r As Range

Set Sht = ActiveSheet
Dim BR As Variant
Dim BlnkRng As Range, SourceRange As Range, fillRange As Range
LstRw = Sht.Cells(Rows.Count, 2).End(xlUp).Row
Set Rng = Sht.Cells(2, 2).Resize(LstRw, 1)

    For Each r In Rng
        On Error Resume Next
        If IsNumeric(r.Value) Then
            If Minute(r.Value) = 12 And Minute(r.Offset(1, 0).Value) = 22 Then
            Rows(r.Row + 1 & ":" & r.Row + 9).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
            ElseIf Minute(r.Value) = 27 And Minute(r.Offset(1, 0).Value) = 40 Then
            Rows(r.Row + 1 & ":" & r.Row + 12).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
            End If
        End If
  
    Next
  
  
'Rearrange
  With Sht.UsedRange
        With .Columns(1)
        BR = Split(.SpecialCells(xlBlanks).Address, ",")
            For i = LBound(BR) To UBound(BR)
              
                Set BlnkRng = Range(BR(i))
                Set SourceRange = BlnkRng.Cells(1, 1).Offset(-2, 0).Resize(2, 3)
                Set fillRange = BlnkRng.Cells(1, 1).Offset(-2, 0).Resize(BlnkRng.Rows.Count + 2, 3)
              
                SourceRange.AutoFill Destination:=fillRange
              
                With BlnkRng.Resize(BlnkRng.Rows.Count, 3).Interior
                    .Pattern = xlSolid
                    .Color = RGB(255, 242, 204)
                End With
              
            Next
        End With
  End With



End Sub
Book1
ABC
1date time [mm/T]
220.11.202004:07:000.1
320.11.202004:08:000
420.11.202004:09:000
520.11.202004:10:000
620.11.202004:11:000
720.11.202004:12:000
820.11.202004:13:000
920.11.202004:14:000
1020.11.202004:15:000
1120.11.202004:16:000
1220.11.202004:17:000
1320.11.202004:18:000
1420.11.202004:19:000
1520.11.202004:20:000
1620.11.202004:21:000
1720.11.202004:22:000.1
1820.11.202004:23:000
1920.11.202004:24:000
2020.11.202004:25:000
2120.11.202004:26:000
2220.11.202004:27:000
2320.11.202004:28:000
2420.11.202004:29:000
2520.11.202004:30:000
2620.11.202004:31:000
2720.11.202004:32:000
2820.11.202004:33:000
2920.11.202004:34:000
3020.11.202004:35:000
3120.11.202004:36:000
3220.11.202004:37:000
3320.11.202004:38:000
3420.11.202004:39:000
3520.11.202004:40:000.1
3620.11.202004:41:000
3720.11.202004:42:000
3820.11.202004:43:000
3920.11.202004:44:000
4020.11.202004:45:000
4120.11.202004:51:000.1
4220.11.202004:52:000
4320.11.202004:53:000
4420.11.202004:54:000
4520.11.202004:55:000
4620.11.202004:56:000
Sheet1
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
55,411
Office Version
  1. 365
Platform
  1. Windows
Another option, this will handle times if your data goes past midnight
VBA Code:
Sub Vuko()
   Dim Ary As Variant, Nary As Variant
   Dim r As Long, nr As Long, i As Long, j As Long
  
   Ary = Range("A1").CurrentRegion.Value2
   ReDim Nary(1 To 1000000, 1 To 3)
   For r = 2 To UBound(Ary)
      nr = nr + 1
      Nary(nr, 1) = Ary(r, 1)
      Nary(nr, 2) = Ary(r, 2)
      Nary(nr, 3) = Ary(r, 3)
      i = 0
      If r <> UBound(Ary) Then
         If Ary(r + 1, 2) > Ary(r, 2) Then
            i = (Ary(r + 1, 2) - Ary(r, 2)) * 1440
         Else
            i = (1 + Ary(r + 1, 2) - Ary(r, 2)) * 1440
         End If
      End If
      If i > 1 Then
         For j = 1 To i - 1
            nr = nr + 1
            Nary(nr, 1) = Ary(r, 1)
            Nary(nr, 2) = Ary(r, 2) + TimeSerial(0, j, 0)
            Nary(nr, 3) = 0
         Next j
      End If
   Next r
   Range("C2").Resize(nr, 3).Value = Nary
End Sub
 

Dossfm0q

Banned User
Joined
Mar 9, 2009
Messages
570
Office Version
  1. 2019
Platform
  1. Windows
VBA Code:
Sub Add_rows_between_time_frames_With_Fill()

Dim R As Range, Rng As Range, AddRng As Range, SrcRng As Range
Dim DM As Long
Set Rng = ActiveSheet.Range("A1").CurrentRegion.Columns(2).Cells
Application.ScreenUpdating = False
  
   For Each R In Rng
    With R
    If IsNumeric(.Value) Then
    On Error Resume Next
     DM = Minute(.Offset(1, 0).Value) - Minute(.Value)
        If DM > 1 And .Offset(1, 0).Value <> "" And .Value <> "" Then
            
            Set AddRng = .Offset(1, -1).Resize(DM - 1, 3)
            AddRng.Rows.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
            
            Set SrcRng = .Offset(-1, -1).Resize(2, 3)
            Set FillRng = .Offset(-1, -1).Resize(DM + 1, 3)
            SrcRng.AutoFill Destination:=FillRng
            
            
        End If
    On Error GoTo 0
     End If
     End With
    Next
Application.ScreenUpdating = True
    
End Sub
 

Watch MrExcel Video

Forum statistics

Threads
1,127,316
Messages
5,623,958
Members
416,002
Latest member
t10k14

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top