Solved: faster way to delete cells not containing certain word

[mcdermott2]

Hi All,

I need to cycle through column A and delete all rows that do not have the word "Box" or contain the word "DELETEX1Y".

The following code works, but is very slow when run on larger files.

LR = Range("A" & Rows.Count).End(xlUp).Row
For i = LR To 2 Step -1
If Not Range("A" & i).Value Like "*Box*" Then Rows(i).Delete
If Range("A" & i).Value Like "*DELETEX1Y*" Then Rows(i).Delete
Next i

Any suggestions?
I was thinking of using a sort, or filter to help me, but I've been trying all day to get one of the two to work to no avail.

[jolivanes]

Not pretty code. Try it on a copy of your workbook.

Sub HowAboutThis()
Application.ScreenUpdating = False
Sheets("Sheet2").Range("A2:A" & Cells(Rows.Count, "A").End(xlUp).Row).AutoFilter Field:=1, Criteria1:="<>*Box*"
With ActiveSheet.AutoFilter.Range
.EntireRow.Delete
End With
Sheets("Sheet2").AutoFilterMode = False
Sheets("Sheet2").Range("A2:A" & Cells(Rows.Count, "A").End(xlUp).Row).AutoFilter Field:=1, Criteria1:="*DELETEX1Y*"
With ActiveSheet.AutoFilter.Range
.EntireRow.Delete
End With
Sheets("Sheet2").AutoFilterMode = False
Application.ScreenUpdating = True
End Sub

I tried to get both criteria in a single line but I could not get that to work.
Someone hopefully shows us how to do that or supplies a better way.

[Bob Phillips]

Surely, there is no need for the second delete, <>*Box* will include *Delete1XY*. Also, you need to start at A1 else if A2 contains Box it will be deleted

Sub HowAboutThis()

Application.ScreenUpdating = False

With Sheets("Sheet2")

.Range("A1:A" & .Cells(.Rows.Count, "A").End(xlUp).Row).AutoFilter Field:=1, Criteria1:="<>*Box*"

With .AutoFilter.Range

.EntireRow.Delete
End With

.AutoFilterMode = False
End With

Application.ScreenUpdating = True
End Sub

[mcdermott2]

Thanks for the response!

I do in fact need the second delete; I want all rows that contain the word box, but not box AND DELETE1XY to remain at the end of this.

[mcdermott2]

Thanks! With just a few tweaks this worked perfectly. --Note, I had to insert a row at 1:1 or else data on that row was getting deleted.


Rows("1:1").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Application.ScreenUpdating = False
Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row).AutoFilter Field:=1, Criteria1:="<>*Box*"
With ActiveSheet.AutoFilter.Range
.EntireRow.Delete
End With
Rows("1:1").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
AutoFilterMode = False
Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row).AutoFilter Field:=1, Criteria1:="*DELETEX1Y*"
With ActiveSheet.AutoFilter.Range
.EntireRow.Delete
End With
AutoFilterMode = False
Application.ScreenUpdating = True

[jolivanes]

Thanks for setting me straight Bob.