Find change in Col A and insert 4 rows using Excel VBA - excel

Question

I'm trying to get my code to insert four rows every time it finds a difference in the cell below. If A5-55 = 1, A56-80 = 2, A81 - 100 = 3 I want the code to see that 56 isn't equal to 55 and insert 4 rows, then continue down the A column until there are no more values.
I keep getting an error from Excel,
can not complete task. Resources error
And then a runtime 1004 insert method of range class failed, and the debugger highlights the code for inserting rows
This is what my data looks like:
Worksheets("HR-Calc").Activate
For lRow = Cells(Cells.Rows.Count, "A").End(xlUp).Row To 6 Step -1
If Cells(lRow, "A") <> Cells(lRow - 1, "A") Then
Rows(lRow).EntireRow.Insert
Rows(lRow).EntireRow.Insert
Rows(lRow).EntireRow.Insert
Rows(lRow).EntireRow.Insert
End If
Next lRow

Answer 1

A neater way would be to use an autofilter on the table
(The code assumes that column A is a sorted integer ID - as seems to be the case from the image)
Sub InsertRowsBetweenIncrements()
Dim ws As Worksheet: Set ws = Worksheets("HR-Calc")
Dim HeaderRow As Long: HeaderRow = 4
Application.ScreenUpdating = False
Dim LastRow As Long: LastRow = ws.Columns(1).Find("*", _
SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Dim LastCol As Long: LastCol = ws.Cells.Find("*", _
SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
Dim Tbl As Range: Set Tbl = ws.Range(Cells(HeaderRow, 1), Cells(LastRow, LastCol))
Dim i As Long, j As Long
For i = ws.Cells(LastRow, 1).Value To 1 Step -1
Tbl.AutoFilter Field:=1, Criteria1:=i
j = Tbl.SpecialCells(xlCellTypeVisible).SpecialCells(xlCellTypeLastCell).Row
Tbl.AutoFilter
If j <> HeaderRow And j < LastRow Then _
ws.Rows(j + 1 & ":" & j + 4).Insert Shift:=xlDown
Next i
Application.ScreenUpdating = True
End Sub

Answer 2

If you want a less-clunky was (as you mentioned), I would default to using arrays to increase speed. Give the code below a try and see what you think. This assumes your data starts in row 6 (if not, change the value of "offset" to the final row before the data in question starts). If you want to change how many rows you insert in the future, just change the value of rows_to_insert to the desired number.
Sub insertrows()
Dim check_col() As Variant
Dim rng As Range
Dim lcell As Range
Dim i As Long
Dim rows_to_insert As Long
Dim rows_added As Long
Dim offset As Long
Dim insert_cell As Long
Worksheets("HR-Calc").Activate
lrow = Cells(Cells.Rows.Count, "A").End(xlUp).Row
Set lcell = Cells(lrow, 1)
Set rng = Range("A6", lcell)
check_col = rng
rows_to_insert = 4
rows_added = 0
offset = 5
rows_added = 0
For i = 1 To (UBound(check_col, 1) - 1)
If check_col(i, 1) <> check_col(i + 1, 1) Then
check_col(i, 1) = i + rows_added + offset
rows_added = rows_added + rows_to_insert
Else: check_col(i, 1) = VBnllstring
End If
Next i
check_col(UBound(check_col, 1), 1) = vbNullString
rows_to_insert = rows_to_insert - 1
For i = 1 To UBound(check_col, 1)
If check_col(i, 1) <> vbNullString Then
insert_cell = check_col(i, 1) + 1
Range(Cells(insert_cell, 1), Cells(insert_cell + rows_to_insert, 1)).EntireRow.Select
Range(Cells(insert_cell, 1), Cells(insert_cell + rows_to_insert, 1)).EntireRow.Insert
End If
Next i
End Sub