VBA Delete all rows that don't contain a color

[decadence]

Hi, I would like to delete rows where the rows don't contain any color, however I have a lot of data to delete so I what I want to do is step through the data and add the rows to an array/collection that don't contain any color then delete them all at once, currently I can do it one row at a time however it takes a long time to do. I can't filter on color as different cells in the rows may or may not contain color. I can have up to 10,0000 rows of data and could end up deleting 9,999 if no cells have any colour in them. can someone help please

The code I am using

Sub DeleteNonColor()

Dim iCntr As Long
Dim Rng As Range
    Set Rng = ActiveSheet.UsedRange
    For iCntr = Rng.Column + Rng.Rows.count - 1 To Rng.row Step -1
        If Not Cells(iCntr, 1).EntireRow.Interior.ColorIndex = 19 Then Rows(iCntr).EntireRow.Delete
    Next

End Sub

 

[Yongle]

Code below assumes that your used range starts in cell A1 (ie that there is something in Row 1 and in column A
Test on a COPY of your data

Code below delete any row containing one or more cell whose ColorIndex is NOT 19

Sub DeleteNonColor()
    Dim Cel As Range, Rng As Range, uRng As Range, c As Long, r As Long
    Set Rng = ActiveSheet.UsedRange
    Set uRng = Rng.Offset(Rng.Rows.Count).Resize(1, 1)
   
    For r = 2 To Rng.Rows.Count
        For c = 1 To Rng.Columns.Count
            Set Cel = Rng.Cells(r, c)
            If Not Cel.Interior.ColorIndex = 19 Then
                Set uRng = Union(uRng, Cel)
                Exit For
            End If
        Next c
    Next r
    uRng.EntireRow.Delete
End Sub

NOTE
uRng always contains at least one cell
Therefore, there is no requirement for the expected condition If Not uRng Is Nothing Then

 

[footoo]

Alternatively, try looping the columns and filter each one by NoFill. Then delete visible cells (entire row).

 

[decadence]

Hi Yongle, the code deleted all cells even with color so I just added "EntireRow" to get the results required, many thanks for your help

Sub DeleteNonColor()
    Dim Cel As Range, Rng As Range, uRng As Range, c As Long, r As Long
    Set Rng = ActiveSheet.UsedRange
    Set uRng = Rng.Offset(Rng.Rows.Count).Resize(1, 1)
   
    For r = 2 To Rng.Rows.Count
        For c = 1 To Rng.Columns.Count
            Set Cel = Rng.Cells(r, c)
            If Not Cel.EntireRow.Interior.ColorIndex = 19 Then
                Set uRng = Union(uRng, Cel)
                Exit For
            End If
        Next c
    Next r
    uRng.EntireRow.Delete
End Sub

 

[Yongle]

Glad you worked it out