# VBA Delete Entire Row if Doesn't Contains Certain Text

#### maxbmx

##### New Member
Hi guys,
Any idea of a quick macro that will help me, I would like to delete all rows that doesn't contains at least IN, CH, EL on column A

I do have many items in my stock list and I would like to keep all parts # that start by IN, CH and EL and delete all the rest that doesn't contains those 2 starts letters

Thank a lot for your help

### Excel Facts

How to calculate loan payments in Excel?
Use the PMT function: =PMT(5%/12,60,-25000) is for a \$25,000 loan, 5% annual interest, 60 month loan.

#### Peter_SSs

##### MrExcel MVP, Moderator
Welcome to the MrExcel board!

.. doesn't contains at least IN, CH, EL on column A

I do have many items in my stock list and I would like to keep all parts # that start by IN, CH and EL a
'Contains' of course can be different to 'starts with'. I have assumed 'starts with'.

Give this a try in a copy of your workbook.
About how many rows of data before you do the deletions?
Asking because this code should be very quick if a large data set (& small) but simpler code could be written for a smaller data set and it would be plenty quick enough.

Code:
``````Sub DelUnwantedParts()
Dim a As Variant, b As Variant
Dim nc As Long, i As Long, k As Long

nc = Cells.Find(What:="*", LookIn:=xlFormulas, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column + 1
a = Range("A2", Range("A" & Rows.Count).End(xlUp)).Value
ReDim b(1 To UBound(a), 1 To 1)
For i = 1 To UBound(a)
Select Case Left(a(i, 1), 2)
Case "IN", "CH", "EL"
Case Else
k = k + 1
b(i, 1) = 1
End Select
Next i
If k > 0 Then
Application.ScreenUpdating = False
With Range("A2").Resize(UBound(a), nc)
.Columns(nc).Value = b
.Resize(k).EntireRow.Delete
End With
Application.ScreenUpdating = True
End If
End Sub``````

#### Peter_SSs

##### MrExcel MVP, Moderator
.. but simpler code could be written for a smaller data set and it would be plenty quick enough.
Here is one such code.
Rich (BB code):
``````Sub DelUnwantedParts_v2()
Application.ScreenUpdating = False
With Range("A1", Range("A" & Rows.Count).End(xlUp))
.Replace What:="IN", Replacement:="CH@@@", LookAt:=xlPart, MatchCase:=True
.AutoFilter Field:=1, Criteria1:="<>CH*", Operator:=xlAnd, Criteria2:="<>EL*"
.Offset(1).EntireRow.Delete
.AutoFilter
.Replace What:="CH@@@", Replacement:="IN", LookAt:=xlPart, MatchCase:=True
End With
Application.ScreenUpdating = True
End Sub``````

#### Joe4

Welcome to the Board!

Someone can probably come up with a slicker solution that doesn't use loops, but this will get the job done:
Code:
``````Sub MyDelete()

Dim lr As Long
Dim r As Long
Dim pfx As String

Application.ScreenUpdating = False

'   Find last row in column A with data
lr = Cells(Rows.Count, "A").End(xlUp).Row

'   Loop through all rows backwards, up to row 2
For r = lr To 2 Step -1
[COLOR=#ff0000]        pfx = Left(Cells(r, "A"), 2)[/COLOR]
If (pfx = "IN") Or (pfx = "CH") Or (pfx = "EL") Then
'do nothing
Else
Rows(r).Delete
End If
Next r

Application.ScreenUpdating = True

End Sub``````
Note that this only looks for "IN", "CH", and "EL". It does not treat "in" the same as "IN".
If you want it to, then change the line in red above to:
Code:
``[COLOR=#FF0000]        pfx = UCase(Left(Cells(r, "A"), 2))[/COLOR]``

#### maxbmx

##### New Member
hi Peter,
looking awesome

what should I modify for:

[FONT=&quot] Case "IN", "CH", "EL”, “D”, “EV”, “EX”, “F0”, “F3”, “F7”, “GF”, “IK”, “KM”, “SH”, “T”

Thank a lot once again[/FONT]

#### Peter_SSs

##### MrExcel MVP, Moderator
what should I modify for:

Case "IN", "CH", "EL”, “D”, “EV”, “EX”, “F0”, “F3”, “F7”, “GF”, “IK”, “KM”, “SH”, “T”
The single characters ones don't adapt so easily to my (first) code as it was designed for 2 characters per your 3 samples. . What can follow "D" or "T"? Several examples?

My second code is not useful for a long list like this (but other options will be possible). I'll wait on the answer to my first question for now.

About how many rows of data before you do the deletions?

Last edited:

#### lrobbo314

##### Well-known Member
This seems to do the trick. Tested with 100k records and it ran in 0.4 seconds.

Code:
``````Sub deleteRows()
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual

Dim cnt As Long:        cnt = 0
Dim r As Range:         Set r = Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row)
Dim ar() As Variant:    ar = r.Value
Dim b As Boolean:       b = False
Dim cpy() As Variant
Dim vals(0 To 13) As String

vals(0) = "IN"
vals(1) = "CH"
vals(2) = "EL"
vals(3) = "D"
vals(4) = "EV"
vals(5) = "EX"
vals(6) = "F0"
vals(7) = "F3"
vals(8) = "F7"
vals(9) = "GF"
vals(10) = "IK"
vals(11) = "KM"
vals(12) = "SH"
vals(13) = "T"

For i = LBound(ar) To UBound(ar)
For k = 0 To UBound(vals)
If Left(ar(i, 1), Len(vals(k))) = vals(k) Then
b = True
Exit For
End If
Next k

If b Then
ReDim Preserve cpy(0 To cnt)
cpy(cnt) = ar(i, 1)
cnt = cnt + 1
End If
b = False
Next i

If cnt > 0 Then
r.ClearContents
Range("A2").Resize(cnt) = Application.Transpose(cpy)
End If

Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
End Sub``````

#### Peter_SSs

##### MrExcel MVP, Moderator
This seems to do the trick
I'm not so sure. It doesn't delete the entire row as requested. So if there is any data in other columns, that data will all remain & further, any connection of that data to the part number (eg cost, supplier etc) would be lost.

@ bmxmax
This is the adaptation to my previous code. It deletes the entire row for any values that do not start with the list you provided (& processed 100,000 rows in 0.024 seconds for me )

Let us know if it fails for some reason.

Rich (BB code):
``````Sub DelUnwantedParts_v2()
Dim a As Variant, b As Variant
Dim nc As Long, i As Long, k As Long
Dim bFound As Boolean

nc = Cells.Find(What:="*", LookIn:=xlFormulas, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column + 1
a = Range("A2", Range("A" & Rows.Count).End(xlUp)).Value
ReDim b(1 To UBound(a), 1 To 1)
For i = 1 To UBound(a)
bFound = False
Select Case True
Case InStr(1, "IN|CH|EL|EV|EX|F0|F3|F7|GF|IK|KM|SH", Left(a(i, 1), 2), 0) > 0: bFound = True
Case InStr(1, "D|T", Left(a(i, 1), 1), 0) > 0: bFound = True
End Select
If Not bFound Then
k = k + 1
b(i, 1) = 1
End If
Next i
If k > 0 Then
Application.ScreenUpdating = False
With Range("A2").Resize(UBound(a), nc)
.Columns(nc).Value = b
.Resize(k).EntireRow.Delete
End With
Application.ScreenUpdating = True
End If
End Sub``````

#### maxbmx

##### New Member
Hi Peter,
I have 5000 rows only

you last one working great but I want to switch column A to D

and I'm getting error for:

Thanks

#### maxbmx

##### New Member
And can we keep row 1 pls? Thanks