Macro for inserting rows if value

[M_8]

Hello,
I'm completely new in VBA and I've have problem with following:
I need a macro to insert rows (and set value) if time value in successive rows are as described:
- if hour value in row_x=5 and row_y=6 insert new row between them and insert value 06:00:00
- if hour value in row_x=13 and row_y=14 insert new row between them and insert value 14:00:00
- if hour value in row_x=21 and row_y=22 insert new row between them and insert value 22:00:00

like in this simplified sheet (green cells):


Is it even possible?

[Aussiebear]

How can someone new to the worksheet determine which is Row X or Row Y from your current layout?

[M_8]

Ok, now I have working inserRow Macro.
Now question is how to read hour value from Column_A and make this macro working on them + adding set values (06 or 14 or 22)?

Sub InsertRowsAtValueChange()
Dim Rng As Range
Dim WorkRng As Range
On Error Resume Next
xTitleId = "KutoolsforExcel"
Set WorkRng = Application.Selection
Set WorkRng = Application.InputBox("Range", xTitleId, WorkRng.Address, Type:=8)
Application.ScreenUpdating = False
For i = WorkRng.Rows.Count To 2 Step -1
    If WorkRng.Cells(i, 1).Value = 2 And WorkRng.Cells(i - 1, 1).Value = 1 Then
        WorkRng.Cells(i, 1).EntireRow.Insert
        ElseIf WorkRng.Cells(i, 1).Value = 3 And WorkRng.Cells(i - 1, 1).Value = 2 Then
            WorkRng.Cells(i, 1).EntireRow.Insert
            ElseIf WorkRng.Cells(i, 1).Value = 1 And WorkRng.Cells(i - 1, 1).Value = 3 Then
                WorkRng.Cells(i, 1).EntireRow.Insert
    End If
Next
Application.ScreenUpdating = True
End Sub

PROGRESS from:

to simplify problem i've made helper column and using google found and changed macro as below.

Sub InsertRowsAtValueChange()
Dim Rng As Range
Dim WorkRng As Range
On Error Resume Next
xTitleId = "KutoolsforExcel"
Set WorkRng = Application.Selection
Set WorkRng = Application.InputBox("Range", xTitleId, WorkRng.Address, Type:=8)
Application.ScreenUpdating = False
For i = WorkRng.Rows.Count To 2 Step -1
    If WorkRng.Cells(i, 1).Value = 2 And WorkRng.Cells(i - 1, 1).Value = 1 Then
        If WorkRng.Cells(i, 1).Value = 3 And WorkRng.Cells(i - 1, 1).Value = 2 Then
            If WorkRng.Cells(i, 1).Value = 1 And WorkRng.Cells(i - 1, 1).Value = 3 Then
                WorkRng.Cells(i, 1).EntireRow.Insert
            End If
            WorkRng.Cells(i, 1).EntireRow.Insert
        End If
        WorkRng.Cells(i, 1).EntireRow.Insert
    End If
Next
Application.ScreenUpdating = True
End Sub

But there is some logic error since it puts empty row only in 1st case (change from shift 2 to shift 1) and i cant tell why other wont work. What am I missing?


If it would work is it possible in VBA to read hour value from column A (like in HOUR() Excel function)?
Not to mention i still need to instert set values in those new rows depending on shift...

[georgiboy]

Maybe:

Sub test()    
    Dim rCnt As Long, x As Long
    Dim hr1 As Integer, hr2 As Integer
    
    rCnt = Range("A" & Rows.Count).End(xlUp).Row
    
    For x = rCnt To 2 Step -1
        hr1 = Hour(Cells(x, 1))
        hr2 = Hour(Cells(x - 1, 1))
        If hr1 = 6 And hr2 = 5 Or hr1 = 14 And hr2 = 13 Or hr1 = 22 And hr2 = 21 Then
            Rows(x).Insert
            Cells(x, 1) = Application.Floor(Cells(x + 1, 1), "01:00:00")
        End If
    Next x
End Sub

[M_8]

That works perfectly!
Thank you!

Only problem i have with it is "type mismatch" error with column header. How can i skip it?

[arnelgp]

see this demo.

[georgiboy]

Change:

For x = rCnt To 2 Step -1

To

For x = rCnt To 3 Step -1

[M_8]

see this demo.

this also works great ,thank you!
Even better because i can choose starting point.