Insert an empty row above a highlighted cell.

[bessieunl]

I want to insert a blank row above each colored cell when in a column

Under column A I have 5268 records
I want to insert a blank row above a cell that is highlighted yellow. I want to do it till the last value under that column.
Can someone tell me please how to write a vba for?
Thank you in advance for your assistance.

My original code isn't doing what I am asking because instead of inserting just one row, its inserting 5268 rows above the first found highlighted cell.

Sub Top10()
'lastrow = ActiveSheet.UsedRange.Rows(ActiveSheet.UsedRange.Rows.count).Row'
Dim c As range

    For Each c In range("A1:A100000")
        If c.Interior.Color = 65535 Then
            c.Offset(0, 0).EntireRow.Insert
        End If
    Next c

End Sub

also, another thing is that I don't want use range actually, because it requires the user to know how many rows of data it has, I want to use a for loop sth like for I = 2 to lastrow?

 

[Joe4]

When inserting or deleting rows, it is best to loop through your range backwards. Otherwise:
- with "insert", you keep hitting the same row (because your rows are moving down at the same time you loop is)
- with "delete", you will miss rows if you have two in a row that should be deleted (because the rows are moving up as you loop is moving down)

So, you want to use something like:

For i = LastRow to 1 Step -1
    If Cells(i,"A").Interior.Color = 65535 Then
        Rows(i).Insert
    End If
Next i

 

[S O WXLS]

When working with rows, always loop backwards:

Sub Top10()


Dim i As Long

For i = Cells(Rows.Count, 1).End(xlUp).Row To 1 Step -1
    If Cells(i, 1).Interior.Color = 65535 Then Cells(i, 1).EntireRow.Insert Shift:=xlDown
Next i

End Sub

 

[revcanon]

Try this:

Sub test()
'
' test Macro
'
    LastRow = Range("A" & Rows.Count).End(xlUp).Row 'This will limit it to only the last row with data, rather than all rows
    Dim i As Integer
    For i = LastRow To 1 Step -1 'This begins reviewing at the bottom and works upwards
        If Range("A" & i).Interior.Color = 65535 Then
            Rows(i).Select
            Selection.Insert Shift:=xlDown ' This inserts your row
            With Rows(i).Interior ' This removes any highlighting from the inserted row
                .Pattern = xlNone
                .TintAndShade = 0
                .PatternTintAndShade = 0
            End With
        End If
    Next i 'goes to next row up

End Sub

 

[bessieunl]

When working with rows, always loop backwards:

Sub Top10()


Dim i As Long

For i = Cells(Rows.Count, 1).End(xlUp).Row To 1 Step -1
    If Cells(i, 1).Interior.Color = 65535 Then Cells(i, 1).EntireRow.Insert Shift:=xlDown
Next i

End Sub

Thanks! This worked perfect!