Insert new rows to separate groups of data via a for loop - excel

Question

I'm using a for loop but I'm open suggestions if there's a better way to separate the data!
I want to insert two new rows whenever the integer in Column 11 or "K" changes. Column K represents groups of data and each is named with integers between 1 and 10 (inclusive). Each group varies in size, hence why I wanted a for loop to check each time the group increments to trigger the insertion of the rows.
For example:
From the data below two blank rows should be inserted below K11 and below K18. This will result in the data being separated by two blank rows whenever two groups were 'touching' each other.
K2 = 1, K3 = 1, K4 = 1 ... K11 = 1
K12 = 2, K13 = 2, K14 = 2... K18 = 2
K19 = 3, K20 = 3 ...
I've put together the following for loop but it inserts 500 (the counter limit) rows after the first group and no row inserts for the remaining groups. Can you explain why this happens and how I can work around this?
Dim LCounter As Integer
For LCounter = 2 To 500
If Cells(LCounter + 1, 11).Value <> Cells(LCounter, 11) Then
Rows(LCounter + 1).Insert shift:=xlShiftDown
End If
Next LCounter

Answer 1

Try this way, please. It should be very fast even for big ranges:
Sub SeparateGroupsByEmptyRows()
Dim LCounter As Long, col As Long, rng As Range
col = 11
For LCounter = 2 To 500
If cells(LCounter + 1, col).Value <> cells(LCounter, col).Value Then
If rng Is Nothing Then
Set rng = cells(LCounter + 1, col)
Else
Set rng = Union(rng, cells(LCounter + 1, col))
End If
End If
Next LCounter
'For the case of two or more consecutive groups of only one row each:
If InStr(rng.Address(0, 0), ":") > 0 Then Set rng = makeDiscontinuu(rng)
rng.EntireRow.Insert Shift:=xlDown
End Sub
Function makeDiscontinuu(rng As Range) As Range
Dim A As Range, c As Range, strAddress As String
For Each A In rng.Areas
If A.cells.count = 1 Then
strAddress = strAddress & A.Address(0, 0) & ","
Else
For Each c In A.cells
strAddress = strAddress & c.Address(0, 0) & ","
Next c
End If
Next A
Set makeDiscontinuu = Range(left(strAddress, Len(strAddress) - 1))
End Function

Answer 2

try this, should be one empty row separation (not tested)
Dim LCounter As Integer, lcEnd as integer: lcEnd =500
For LCounter = 2 To lcEnd
If Cells(LCounter + 1, 11).Value <> Cells(LCounter, 11) and Cells(LCounter + 1, 11)<> "" Then
Rows(LCounter + 1).Insert shift:=xlShiftDown
lcEnd =lcEnd +1
End If
Next LCounter

Answer 3

Insert Rows Before Change of Cell Value
The first procedure uses For...Next to solve the problem by looping backwards.
The second procedure uses Do...Loop illustrating the complications when looping forwards.
The Code
Option Explicit
Sub insertBeforeChangeForNext()
Const iRows As Long = 2 ' Number of Rows to Insert
Const cCol As Long = 11 ' Criteria Column
Const fRow As Long = 2 ' First Row
' Either...
Const lRow As Long = 500 ' Last Row
' ...or rather determine the last non-empty row:
'Dim lRow As Long: lRow = Cells(Rows.Count, cCol).End(xlUp).Row ' LR
If lRow <= fRow Then
Exit Sub
End If
Application.ScreenUpdating = False
Dim LCounter As Long ' Rows Counter
For LCounter = lRow - 1 To fRow Step -1
If Cells(LCounter + 1, cCol).Value <> Cells(LCounter, cCol).Value Then
Rows(LCounter + 1).Resize(iRows).Insert
End If
Next LCounter
Application.ScreenUpdating = True
End Sub
Sub insertBeforeChangeDoLoop()
Const iRows As Long = 2 ' Number of Rows to Insert
Const cCol As Long = 11 ' Criteria Column
Const fRow As Long = 2 ' First Row
' Either...
Const lRow As Long = 500 ' Initial Last Row
' ...or rather determine the last non-empty row:
'Dim lRow As Long: lRow = Cells(Rows.Count, cCol).End(xlUp).Row ' ILR
Dim Current As Long: Current = fRow ' Current Row
Dim Last As Long: Last = lRow ' Current Last Row
Application.ScreenUpdating = False
Do While Current < Last
If Cells(Current + 1, cCol).Value <> Cells(Current, cCol).Value Then
Rows(Current + 1).Resize(iRows).Insert
Last = Last + iRows
Current = Current + iRows
End If
Current = Current + 1
Loop
Application.ScreenUpdating = True
End Sub