VBA Delete Entire Row if Doesn't Contains Certain Text

maxbmx

New Member
Joined
Oct 4, 2019
Messages
7
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

Can you AutoAverage in Excel?
There is a drop-down next to the AutoSum symbol. Open the drop-down to choose AVERAGE, COUNT, MAX, or MIN
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
      .Sort Key1:=.Columns(nc), Order1:=xlAscending, Header:=xlNo
      .Resize(k).EntireRow.Delete
    End With
    Application.ScreenUpdating = True
  End If
End Sub
 
Upvote 0
.. 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
 
Upvote 0
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]
 
Upvote 0
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]
 
Upvote 0
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.

And what about this question:
About how many rows of data before you do the deletions?
 
Last edited:
Upvote 0
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
 
Upvote 0
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
      .Sort Key1:=.Columns(nc), Order1:=xlAscending, Header:=xlNo
      .Resize(k).EntireRow.Delete
    End With
    Application.ScreenUpdating = True
  End If
End Sub
 
Upvote 0
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:

Sort Key1:=.Columns(nc), Order1:=xlAscending, Header:=xlNo

Thanks
 
Upvote 0

Forum statistics

Threads
1,213,482
Messages
6,113,913
Members
448,532
Latest member
9Kimo3

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top