VBA: Auto-Add Blank Line after group

[NeoSez]

I have this code provided by @mehidy1437 (thank you) that I have been using.
Is it possible to auto-add lines when the group of numbers change?
I don't know if I'm explaining it right.
See example below.

Example
1111
1111
(insert blank Line
2222
2222
(insert blank Line
3333
3333
3333
(insert blank Line

Sub InsertAlternateRows()

'vba run or not confirmation
Dim Msg As String, Ans As Variant

    Msg = "This will insert blank row after a selected no# of row, row no will be given by the user."

    Ans = MsgBox(Msg, vbYesNo)

    Select Case Ans

        Case vbYes
'vba run or not confirmation


'This code will insert a row after every row in the selection
'https://trumpexcel.com/insert-blank-row-after-every-row/

Dim Rng As Range

Dim CountRow As Integer

Dim i As Integer

Dim e As Integer
Dim f As Integer
e = InputBox("Enter number, you will have a blank row after every 'given no#' row", "Input Required")
f = e + 1

Set Rng = Selection

CountRow = Rng.EntireRow.count

'For i = 1 To CountRow
'ActiveCell.EntireRow.Insert
'ActiveCell.Offset(3, 0).Select

'For i = 1 To CountRow / 2

    'ActiveCell.Offset(2, 0).EntireRow.Insert
    'ActiveCell.Offset(3, 0).Select

'For i = 1 To CountRow / 3
For i = 1 To CountRow / e

    ActiveCell.Offset(e, 0).EntireRow.Insert
    ActiveCell.Offset(f, 0).Select


Next i

'vba run or not confirmation

    Case vbNo
        GoTo Quit:
    End Select

Quit:
'vba run or not confirmation

End Sub

 

[smozgur]

I assume this new question is not related with the macro above.

In that case, please try following code. Select the range, and execute the code. The code is actually short, but contains comments to explain what's happening at each line.

Sub insertBlankRow()
Dim rng As Range
Dim cll As Range
    ' Working with the selection
    Set rng = Selection
    ' Loop through the cells in the selection
    ' We are starting from the bottom - see Step -1 in the loop definition
    ' so the added blank cells will not affect the next cell
    For i = rng.Rows.Count To 1 Step -1
        ' No need to create a new object variable
        ' but it is easy to read the code, so we create the cll variable to refer to the current cell
        Set cll = rng.Cells(i, 1)
        ' Checking if the current cell is in the first row or if it is the first cell at the top
        ' then check if the cell above the current cell has a different value
        If cll.Row > 1 And i > 1 And cll.Offset(-1).Value <> cll.Value Then
            ' Values are different, so we can add a blank row
            cll.EntireRow.Insert xlShiftDown
        End If
    Next i
End Sub

 

[NeoSez]

I assume this new question is not related with the macro above.

In that case, please try following code. Select the range, and execute the code. The code is actually short, but contains comments to explain what's happening at each line.

Sub insertBlankRow()
Dim rng As Range
Dim cll As Range
    ' Working with the selection
    Set rng = Selection
    ' Loop through the cells in the selection
    ' We are starting from the bottom - see Step -1 in the loop definition
    ' so the added blank cells will not affect the next cell
    For i = rng.Rows.Count To 1 Step -1
        ' No need to create a new object variable
        ' but it is easy to read the code, so we create the cll variable to refer to the current cell
        Set cll = rng.Cells(i, 1)
        ' Checking if the current cell is in the first row or if it is the first cell at the top
        ' then check if the cell above the current cell has a different value
        If cll.Row > 1 And i > 1 And cll.Offset(-1).Value <> cll.Value Then
            ' Values are different, so we can add a blank row
            cll.EntireRow.Insert xlShiftDown
        End If
    Next i
End Sub

That's exactly what I needed.
Works very well. Short and sweet!
I really appreciate the comments to help me learn.

smozgur Thank you ​

 

[smozgur]

You're welcome.

Thanks for the feedback, and also marking solution posts in your questions!