PDA

View Full Version : [SOLVED] VBA to delete rows if font colour is Red?



roxnoxsox
09-04-2015, 02:26 AM
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
09-04-2015, 02:38 AM
deleting rows (the title of the thread) is different than clearing cells (the code you posted).
?

roxnoxsox
09-04-2015, 02:43 AM
Oh Apologies!! It is delete row I want to do, not clear contents, sorry

Tom Jones
09-04-2015, 03:39 AM
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
09-04-2015, 04:16 AM
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
09-04-2015, 05:17 AM
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
09-04-2015, 05:45 AM
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
09-04-2015, 05:52 AM
Wow this really worked! Thank you so much, I honestly didn't believe I'd find a solution!! :D

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
10-30-2015, 03:36 AM
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
10-30-2015, 06:00 AM
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
10-30-2015, 06:10 AM
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
10-30-2015, 07:47 AM
Perfect answers, thank you!

mancubus
10-30-2015, 07:50 AM
you are welcome. thanks for marking the thread as solved.