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):
https://i.ibb.co/dM4f8p9/timestamps.jpg (https://imgbb.com/)https://i.ibb.co/jZ9NJQp/timestamps2.jpg (https://imgbb.com/)

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?
https://i.ibb.co/mTwFTqd/timestamps3.jpg (https://imgbb.com/)

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.