VBA to insert blank row after repeating cell values in a column

[KP_SoCal]

In Column A, I have several repeating cell values. I would l like to insert a blank row at point the value changes into a new set of repeating values. The illustration below should better illustrate what I’m trying to get at.

Before code execution…
A1: Title
A2: Apple
A3: Apple
A4: Apple
A5: Pear
A6: Pear
A7: Orange
A8: Orange
A9: Orange


AFTER code execution…
A1: Title
A2: Apple
A3: Apple
A4: Apple
A5:
A6: Pear
A7: Pear
A8:
A9: Orange
A10: Orange
A11: Orange

Here’s a nice link that points me in the general direction of what I need, but I can’t figure out how to tailor it to my specific needs. Thanks for any suggestions!

 

[Peter_SSs]

What do I need to change to get it to affect the whole Row ...?

I'm not sure that I understand exactly what you want, or what you have to start with or that I would still approach this problem in the same way nearly 7 years ago so you may need to fill in some more details, including approximately how many rows of data you have and how many rows might get inserted.
However, does changing that red line of code to .EntireRow instead of .EntireColumn get you any closer to what you want?

 

[robertwp7472]

Thank you Peter for taking the time to reply. I was able to resolve my problem in another way. However, your code was instrumental in finding the answer.

 

[ebilbrough]

Hi Peter - this works great for me for a single row entry. What changes would be made to the code to insert 2 blank lines rather than just 1?

 

[ebilbrough]

Refering to this code...
Sub InsertRows()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
With Range("A1", Range("A" & Rows.Count).End(xlUp))
.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(1), _
Replace:=True, PageBreaks:=False, SummaryBelowData:=True
.Offset(2, -1).SpecialCells(xlCellTypeConstants).Offset(, 1).ClearContents
.Offset(, -1).EntireColumn.Delete
.EntireColumn.RemoveSubtotal
End With
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

 

[Peter_SSs]

Hi Peter - this works great for me for a single row entry. What changes would be made to the code to insert 2 blank lines rather than just 1?

I've been away for a while. Try inserting the blue line shown below.

Refering to this code...
Sub InsertRows()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
With Range("A1", Range("A" & Rows.Count).End(xlUp))
.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(1), _
Replace:=True, PageBreaks:=False, SummaryBelowData:=True
.Offset(2, -1).SpecialCells(xlCellTypeConstants).Offset(, 1).ClearContents
.SpecialCells(xlBlanks).EntireRow.Insert
.Offset(, -1).EntireColumn.Delete
.EntireColumn.RemoveSubtotal
End With
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

 

[Cybershaolin]

Sub InsertRows()
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    With Range("A1", Range("A" & Rows.Count).End(xlUp))
        .Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(1), _
            Replace:=True, PageBreaks:=False, SummaryBelowData:=True
        .Offset(2, -1).SpecialCells(xlCellTypeConstants).Offset(, 1).ClearContents
        .Offset(, -1).EntireColumn.Delete
        .EntireColumn.RemoveSubtotal
    End With
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

Hi Peter,

I use your code and it works very well. However, I would need one adjustment and I'm scratching my head since a while how to achieve it. I'm not really good at coding...

I'm trying to make that new inserted row completely blank (without any formatting). Now, the new row retains the format of the previous line where there is a filled color.

What would be your modified code suggestion?

 

[Peter_SSs]

What would be your modified code suggestion?

Welcome to the MrExcel board!

Try making this change.

<del>.Offset(2, -1).SpecialCells(xlCellTypeConstants).Offset(, 1).ClearContents</del>
.Offset(2, -1).SpecialCells(xlCellTypeConstants).EntireRow.Clear

 

[Cybershaolin]

This is just perfect!

Thanks a lot.

 

[Peter_SSs]

This is just perfect!

Thanks a lot.

You are very welcome.