Add rows between time frames

V

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.
 

Excel Facts

Create a Pivot Table on a Map
If your data has zip codes, postal codes, or city names, select the data and use Insert, 3D Map. (Found to right of chart icons).
Sort by date Sort by votes
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
 
Upvote 0
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
 
Upvote 0
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
 
Upvote 0
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
 
Upvote 0
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
 
Upvote 0
You must log in or register to reply here.

Similar threads

K
  • Question
Excel Pivot table Time Values is not populating same as Source Sheet
Replies
1
Views
294
awoohaw
awoohaw
J
  • Solved
Excel Formula to highlight most recent record
Replies
3
Views
78
etaf
etaf
Z
  • Solved
Formula to find 'Part of the Day' from the Time Column
Replies
8
Views
289
Zee996
Z
P
  • Question
Formula to find the time difference between two dates and times
Replies
1
Views
385
etaf
etaf
N
  • Solved
Formula to get the range of certain Category
2 3
Replies
25
Views
339
Peter_SSs
Peter_SSs

Forum statistics

Threads
1,214,383
Messages
6,119,198
Members
448,874
Latest member
Lancelots

Share this page

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
Back
Top