Help With Delete Row Code

[Dazzawm]

I am a novice when writing code but have written the code below that looks for the word 'Bus' (as an example) in a cell and delete the entire row. How do I change the code so that it deletes the row if the word 'Bus' is amongst other data in the cell and not on its own. Thanks. Also I want the code to look for all case types (BUS, bus, Bus)

Sub Delete()
Application.ScreenUpdating = False
Dim A As Long
Dim B As Long
Range("R1").Select
A = Selection.CurrentRegion.Rows.Count
For B = 1 To A
If Selection.Value = "Bus" Then 'Change word when necessary
Selection.EntireRow.Delete
Else
Selection.Offset(1, 0).Select
End If
Next B
Application.ScreenUpdating = True
End Sub

 

[Dazzawm]

Hi again VoG, how do I amend the code to look for more than one word at a time e.g Bus & Van? Thanks

 

[VoG]

Try this - if either bus or van is found the row won't be deleted.

Sub Delete()
Application.ScreenUpdating = False
Dim A As Long
Dim B As Long
Range("R1").Select
A = Selection.CurrentRegion.Rows.Count
For B = A To 1 Step -1
If InStr(LCase(Selection.Value), "bus") = 0 And InStr(LCase(Selection.Value), "van") = 0 Then
Selection.EntireRow.Delete
Else
Selection.Offset(1, 0).Select
End If
Next B
Application.ScreenUpdating = True
End Sub

 

[Dazzawm]

Thanks VoG

 

[Dazzawm]

Before

Excel Workbook
	R
1	a bus
2	bus
3	busted
4	a bus
5	s
6	d
7	busty
8	buses
Sheet3

Sub Delete()
Application.ScreenUpdating = False
Dim A As Long
Dim B As Long
Range("R1").Select
A = Selection.CurrentRegion.Rows.Count
For B = A To 1 Step -1
If InStr(LCase(Selection.Value), "bus") = 0 Then
Selection.EntireRow.Delete
Else
Selection.Offset(1, 0).Select
End If
Next B
Application.ScreenUpdating = True
End Sub

After

Excel Workbook
	R
1	a bus
2	bus
3	busted
4	a bus
5	busty
6	buses
7
8
9
10
11
Sheet3

Hi VoG all of a sudden this is bugging out and pointing to :-

Selection.EntireRow.Delete

Why would this be? It has got 300,000 rows to look at would that be it for some reason?

 

[VoG]

I don't know why that would error but this should be faster with 300,000 rows

Sub DeleteMe()
Dim A As Long
Dim B As Long
Application.ScreenUpdating = False
A = Range("A" & Rows.Count).End(xlUp).Row
For B = A To 1 Step -1
    If InStr(LCase(Range("R" & B).Value), "bus") = 0 Then Rows(B).Delete
Next B
Application.ScreenUpdating = True
End Sub

 

[Dazzawm]

Tried it and it just froze and had to esc after about 45mins.

 

[VoG]

Try this

Sub Dazza()
Dim r As Range, LR As Long
Application.ScreenUpdating = False
LR = Range("R" & Rows.Count).End(xlUp).Row
Set r = Cells(2, 1).Resize(LR - 1, 1)
Cells(1, 18).AutoFilter field:=1, Criteria1:="<>*bus*"
r.SpecialCells(xlCellTypeVisible).EntireRow.Delete
Cells(1, 18).AutoFilter
Application.ScreenUpdating = True
End Sub

 

[Dazzawm]

That deleted every row. Remember the word bus will be amongst other text as well as on its own in a cell. (Which is why I cant do sort then delete).

 

[VoG]

For me it only deleted rows where bus did not appear anywhere in column R of the row.

That is because of this

Cells(1, 18).AutoFilter field:=1, Criteria1:="<>*bus*"

 

[Dazzawm]

I dont know where to go from here then if it works for you!