Insert blank Rows without formatting

[Cowichandave]

Here is the code I have so far.

ActiveCell.EntireRow.Resize(3).Insert Shift:=xlDown
For lRow = Cells(Cells.Rows.Count, "C").End(xlUp).Row To 2 Step -1
        If Cells(lRow, "C") <> Cells(lRow - 1, "C") Then
            Rows(lRow).EntireRow.Insert
            Rows(lRow).EntireRow.Insert
            Rows(lRow).EntireRow.Insert
        End If
    Next lRow

The result is this:

I want it to look like below.. Column C is the target for inserting blank rows. I need 3 blank rows without any formatting including conditional formats. Column c may number as high as 40.

 

[Legacy 143009]

Hi,

If you are pointing rows, you don't have to use EntireRow:

  ActiveCell.EntireRow.Resize(3).Insert Shift:=xlDown
  For lRow = Cells(Cells.Rows.Count, "C").End(xlUp).Row To 2 Step -1
    If Cells(lRow, "C") <> Cells(lRow - 1, "C") Then
      Rows(lRow).Insert
      Rows(lRow).Insert
      Rows(lRow).Insert
      Rows(lRow).Resize(3).Clear
    End If
  Next lRow

 

[Peter_SSs]

@Cowichandave
When posting vba code in the forum, please use the available code tags. It makes your code much easier to read/debug & copy. My signature block below has more details. I have added the tags for you this time.

 

[Cowichandave]

Hi,

If you are pointing rows, you don't have to use EntireRow:

  ActiveCell.EntireRow.Resize(3).Insert Shift:=xlDown
  For lRow = Cells(Cells.Rows.Count, "C").End(xlUp).Row To 2 Step -1
    If Cells(lRow, "C") <> Cells(lRow - 1, "C") Then
      Rows(lRow).Insert
      Rows(lRow).Insert
      Rows(lRow).Insert
      Rows(lRow).Resize(3).Clear
    End If
  Next lRow

This is inserting 3 blank rows below and 3 blank rows above when it finds a value in Column C. How do I change it to only insert 3 rows above the value in Column C

 

[Legacy 143009]

I don't think I got it quite right. Like this?

Sub test()
  For Each cll In Range("C2:C" & Cells(Rows.Count, "C").End(xlUp).Row)
    If cll.Value <> "" Then
      cll.EntireRow.Resize(3).Insert
      Rows(cll.Row).Offset(-3).Resize(3).Clear
    End If
  Next
End Sub

 

[Legacy 143009]

Please discard the previous post. Use this instead:

Sub test()
  Dim lRow As Long, i As Long
  lRow = Cells(Rows.Count, "C").End(xlUp).Row
  For i = lRow To 2 Step -1
    If Cells(i, "C").Value <> "" Then
      Rows(i).Resize(3).Insert
      Rows(i).Resize(3).Clear
    End If
  Next
End Sub

 

[Cowichandave]

Hi,

If you are pointing rows, you don't have to use EntireRow:

  ActiveCell.EntireRow.Resize(3).Insert Shift:=xlDown
  For lRow = Cells(Cells.Rows.Count, "C").End(xlUp).Row To 2 Step -1
    If Cells(lRow, "C") <> Cells(lRow - 1, "C") Then
      Rows(lRow).Insert
      Rows(lRow).Insert
      Rows(lRow).Insert
      Rows(lRow).Resize(3).Clear
    End If
  Next lRow

Please discard the previous post. Use this instead:

Sub test()
  Dim lRow As Long, i As Long
  lRow = Cells(Rows.Count, "C").End(xlUp).Row
  For i = lRow To 2 Step -1
    If Cells(i, "C").Value <> "" Then
      Cells(i, "C").EntireRow.Resize(3).Insert
      Rows(Cells(i, "C").Row).Resize(3).Clear
    End If
  Next
End Sub

That is fabulous. Many thanks. Consider this solved

 

[Legacy 143009]

You are welcome Also you can mark the post as answer to help future visitors.