VBA to delete rows if font colour is Red?

[roxnoxsox]

Hi there,

I'm trying to create a macro which will search through all data in A2-Q2 down and delete any rows where a cell contains red font. This may occur in any column between A-Q. I can only get this to work for a set range but my range will change every day as there may be more rows or less rows? - (for example, in below code, this searches to Q3000 but I need this to change in case I have more or less rows). Can anyone help with this at all?

Sub DeleteRedCells()

Dim rng As Range

Set rng = [A2:Q3000]
For Each Cell In rng
 If Cell.Font.ColorIndex = 3 Then
  Cell.ClearContents
 End If
Next Cell

End Sub

[mancubus]

deleting rows (the title of the thread) is different than clearing cells (the code you posted).
?

[roxnoxsox]

Oh Apologies!! It is delete row I want to do, not clear contents, sorry

[Tom Jones]

Try this code:

Sub RemoveRedFont()
Dim k As Long
With ActiveSheet
If .AutoFilterMode Then .AutoFilterMode = False
k = .Range("A" & .Rows.Count).End(xlUp).Row
With .Range("A1").Resize(k)
.AutoFilter
.AutoFilter Field:=1, Criteria1:=RGB(255, 0, 0), Operator:=xlFilterFontColor
.Offset(1).Resize(k - 1).SpecialCells(xlCellTypeVisible).EntireRow.Delete
End With
.AutoFilterMode = False
End With
End Sub

[mancubus]

Sub vbax_53658_DelRowsOnCondition()

    Dim LastRow As Long, LastCol As Long
    Dim r As Long, c As Long
    
    With Worksheets("Sheet1") 'change worksheet name to suit
        LastRow = .Cells.Find("*", , , , xlByRows, xlPrevious).Row
        LastCol = .Cells.Find("*", , , , xlByColumns, xlPrevious).Column
        For r = LastRow To 2 Step -1
            For c = 1 To LastCol
                If .Cells(r, c).Font.ColorIndex = 3 Then
                    .Rows(r).Delete
                    Exit For
                End If
            Next c
        Next r
    End With

End Sub

[roxnoxsox]

Apologies, I can see after testing your above code (mancubus) on a different spreadsheet with normal cells changed to red font - this does work. This will not work on my spreadsheet however, as I have used conditional formatting to make the fonts red. Is there still a way to do this at all or will it not be possible due to CF? Sorry, I had not realised this

[mancubus]

insert DisplayFormat after cell reference

Sub vbax_53658_DelRowsOnCondition_CF()
     
    Dim LastRow As Long, LastCol As Long
    Dim r As Long, c As Long
     
    With Worksheets("Sheet1") 'change worksheet name to suit
        LastRow = .Cells.Find("*", , , , xlByRows, xlPrevious).Row
        LastCol = .Cells.Find("*", , , , xlByColumns, xlPrevious).Column
        For r = LastRow To 2 Step -1
            For c = 1 To LastCol
                If .Cells(r, c).DisplayFormat.Font.ColorIndex = 3 Then
                    .Rows(r).Delete
                    Exit For
                End If
            Next c
        Next r
    End With
     
End Sub

[roxnoxsox]

Wow this really worked! Thank you so much, I honestly didn't believe I'd find a solution!!

There's only one slight problem and that is that I have a button on my spreadsheet which is what I click to run this macro, however it gets deleted in the process. Is there any way of keeping it there?



^^EDIT: I have found how to fix this now. Many thanks for all your help, it's super appreciated; you're a genius ^_^

[roxnoxsox]

Would there be a way to adjust this so that it only KEEPS rows where the contents of column D is conditionally formatted red?

Also, at the moment this macro is taking a veeery long time to run as I have a lot of data to work through. Is there any way of speeding it up at all or is this just the way it has to be?

[mancubus]

this will delete the rows if the cells in Column D have Automatic Font Color (default, unchanged font color)

Sub vbax_53658_Delete_Not_CF_Rows()
     
    With Worksheets("Sheet1") 'change worksheet name to suit
        .AutoFilterMode = False
        .UsedRange.AutoFilter Field:=4, Operator:=xlFilterAutomaticFontColor
        .UsedRange.Columns(1).Offset(1).SpecialCells(12).EntireRow.Delete
        .AutoFilterMode = False
    End With

End Sub

[mancubus]

and this will speed up the row deletion process.

be very careful: it loops columns, filters rows with red font (whether they be conditionally formatted or not), and deletes them.

Sub vbax_53658_Delete_Red_Font_Rows_CF_Or_Colored()
     
    Dim LastCol As Long, c As Long
    
    With Worksheets("Sheet1") 'change worksheet name to suit
        .AutoFilterMode = False
        LastCol = .Cells.Find("*", , , , xlByColumns, xlPrevious).Column
        For c = 1 To LastCol
            .UsedRange.AutoFilter Field:=c, Criteria1:=RGB(255, 0, 0), Operator:=xlFilterFontColor
            .UsedRange.Columns(1).Offset(1).SpecialCells(12).EntireRow.Delete
            .AutoFilterMode = False
        Next c
    End With

End Sub

[roxnoxsox]

Perfect answers, thank you!

[mancubus]

you are welcome. thanks for marking the thread as solved.