Delete cells with a certain property

[jmatchus]

Hello!

This is probably elementary but I can't seem to get it right. My goa
is to delete all cells in a column that are in red. That's it! I jus
can't seem to do it. Thanks for any help you can give

 

[Ron de Bruin]

Hi

Try this example for column A

Sub Example1()
Dim Firstrow As Long
Dim Lastrow As Long
Dim Lrow As Long
Dim CalcMode As Long

With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With

Firstrow = ActiveSheet.UsedRange.Cells(1).Row
Lastrow = ActiveSheet.UsedRange.Rows.Count + Firstrow - 1
With ActiveSheet
.DisplayPageBreaks = False
For Lrow = Lastrow To Firstrow Step -1
If .Cells(Lrow, "A").Interior.ColorIndex = 3 Then .Rows(Lrow).Delete
Next
End With
With Application
.ScreenUpdating = True
.Calculation = CalcMode
End With
End Sub

 

[Chip Pearson]

Try something like the following:

Dim RowNdx As Long
Dim LastRow As Long
With ActiveSheet
LastRow = .Cells(Rows.Count, "A").End(xlUp).Row
For RowNdx = LastRow To 1 Step -1
If .Cells(RowNdx, "A").Interior.ColorIndex = 3 Then
.Rows(RowNdx).Delete
End If
Next RowNdx
End With

This will delete those cells with a fill color of red. If you
want to delete those with a font color of red, change 'Interior'
to 'Font'. Change the "A" in both places to the column
containing your data.


--
Cordially,
Chip Pearson
Microsoft MVP - Excel
Pearson Software Consulting, LLC
www.cpearson.com

 

[L. Howard Kittle]

Hi jmatchus,

Maybe something like this will get you going.

Sub RedOnes()
Dim Mud As Range, cell As Range
Set Mud = Range("A1:A20")
For Each cell In Mud
If cell.Interior.ColorIndex = 3 Then
cell.ClearContents
cell.Interior.ColorIndex = xlNone
End If
Next
End Sub

HTH
Regards,
Howard

 

[Greg Wilson]

Assuming the column is Column A and there is data in all
cells in the range containing the red cells:

Sub DeleteRedCells()
Dim i As Long, X As Long, Rw As Long
Rw = Cells(Rows.Count, 1).End(xlUp).Row
i = 1
Do Until X = Rw
If Cells(i, 1).Interior.ColorIndex = 3 Then
Cells(i, 1).Delete Shift:=xlUp
Else
i = i + 1
End If
X = X + 1
Loop
End Sub

Regards,
Greg

 

[jmatchus]

Thank you very much for all the help! I started with the firs
suggestion and it worked great. My only other problem now that
didn't realize is that I also need to delete all borders in the cells
Any suggestions for that? I really appreciate all of your time

 

[jmatchus]

Never mind! I just deleted all blank rows and it got rid of them.
Thanks for being so helpful

 

[Robert McCurdy]

Select the top left cell for the column or range you wish to have red rows deleted.

Sub DelRedRows3()
Dim Rng As Range, c As Range
On Error GoTo end1
Set Rng = ActiveCell.Resize(ActiveSheet.UsedRange.Rows.Count, 1)
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Rng.EntireColumn.Insert shift:=xlToLeft
With Rng.Offset(0, -1)
.Formula = "=Row()"
For Each c In Rng.Cells
If c.Interior.ColorIndex = 3 Then _
c.Offset(0, -1).Formula = 0
Next c
.CurrentRegion.Sort key1:=.Cells(1), Order1:=xlAscending, header:=xlNo
.Cells(1).Resize(Application.CountIf(.Cells, 0), 1).EntireRow.Delete
end1:
If Err.Number <> 0 Then MsgBox "No Red cells were found"
.EntireColumn.Delete
End With
End Sub


This should run fairly fast, as it deletes all the red rows in one go.
My testing showed it slowed down after several runs, but the first one deleted 10,000 rows from a 40,000 row range within 3 seconds.


Regards Robert