Filtering based on background color

[sprimax]

Folks,

Let's say I have :
Header : row #1
The rest of data to filter : row #2 till the end (max at 2,000 rows)

How to do filter based on background color at column B?
What I want is : if color index <> 24 then delete all rows (starting from row #2)

This code is working, but it takes a long time to process 1,500 rows. Is there any suggestion to speed it up ?

Sub DeleteCells()
Application.ScreenUpdating = False ' To freeze the display
For I = 1500 To 2 Step -1
If Cells(I, "B").Interior.ColorIndex <> 24 Then Cells(I,"B").EntireRow.Delete
Next I
Application.ScreenUpdating = True

End Sub

Thanks in advance

 

[Trevor G]

What about switching auto calculation off and warnings off

Sub DeleteCells()
Dim i As Integer
Application.ScreenUpdating = False ' To freeze the display
Application.Calculation = xlCalculationManual
Application.DisplayAlerts = False
For i = 1500 To 2 Step -1
If Cells(i, "B").Interior.ColorIndex <> 24 Then Cells(i, "B").EntireRow.Delete
Next i
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.DisplayAlerts = True
End Sub

 

[Peter_SSs]

What version of Excel are you using?

 

[sprimax]

Dear Peter,

I'm using Office 2007.

Thanks

 

[sprimax]

Hi Trevor,

Thanks for your response. I'll try. To delete 1,500 rows using VBA should take no more than 10 seconds.

I'll let you know the result, soon.

Thank you

 

[Trevor G]

Try this as alternative as your using 2007 you can filter by colour then delete the filter. Not tested though

Sub DelCol()
Selection.AutoFilter
Range("A1:B15000").AutoFilter field:=2, Criteria1:=RGB(204, 204, 205), Operator:=xlFilterCellColor
Application.DisplayAlerts = False
ActiveSheet.UsedRange.Offset(1, 0).Resize(ActiveSheet.UsedRange.Rows.Count - 1).Rows.Delete
Application.DisplayAlerts = True

End Sub

 

[sprimax]

Hi Trevor & Peter,

It took only 4 seconds using Trevor's code, with the previous code I have to wait almost 30 seconds !

Wonderful !

Thanks everyone. Problem solved !

 

[Trevor G]

Pleased to read you have a working solution.

Thanks for the feed back.

 

[Peter_SSs]

It took only 4 seconds using Trevor's code, with the previous code I have to wait almost 30 seconds !

Give this one a try as well.

<font face=Courier New><br><SPAN style="color:#00007F">Sub</SPAN> DelRowsBasedOnColour()<br>    <SPAN style="color:#00007F">Dim</SPAN> b<br>    <SPAN style="color:#00007F">Dim</SPAN> lr <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>, i <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>, lc <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN><br>    <br>    lc = Cells.Find(what:="*", After:=Range("A1"), SearchOrder:=xlByColumns, _<br>        Searchdirection:=xlPrevious, Searchformat:=False).Column + 1<br>    lr = Range("B" & Rows.Count).End(xlUp).Row<br>    <SPAN style="color:#00007F">ReDim</SPAN> b(1 <SPAN style="color:#00007F">To</SPAN> lr, 1 <SPAN style="color:#00007F">To</SPAN> 1)<br>    Application.ScreenUpdating = <SPAN style="color:#00007F">False</SPAN><br>    <SPAN style="color:#00007F">For</SPAN> i = 1 <SPAN style="color:#00007F">To</SPAN> lr<br>        <SPAN style="color:#00007F">If</SPAN> Cells(i, "B").Interior.ColorIndex = 24 <SPAN style="color:#00007F">Then</SPAN><br>            b(i, 1) = 1<br>        <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN><br>    <SPAN style="color:#00007F">Next</SPAN> i<br>    Cells(1, lc).Resize(lr).Value = b<br>    Range("A1").Resize(lr, lc).Sort Key1:=Cells(2, lc), Order1:=xlDescending, Header:=xlYes, _<br>        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal<br>    <SPAN style="color:#00007F">On</SPAN> <SPAN style="color:#00007F">Error</SPAN> <SPAN style="color:#00007F">Resume</SPAN> <SPAN style="color:#00007F">Next</SPAN><br>    Cells(2, lc).Resize(lr - 1).SpecialCells(xlCellTypeBlanks).EntireRow.Delete<br>    <SPAN style="color:#00007F">On</SPAN> <SPAN style="color:#00007F">Error</SPAN> <SPAN style="color:#00007F">GoTo</SPAN> 0<br>    Application.ScreenUpdating = <SPAN style="color:#00007F">True</SPAN><br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN><br></FONT>

 

[sprimax]

Hi Peter,

More than 1 hour to analyze your magical code, but still I can't imagine how your filtering/looping so fast, what I knew is you are trying to give a value to column 35 then but I didn't know how.

To me, it's complicated code. But it is really great ! The world needs a man like you.

Thanks so muuuccchhhhh .....