Fastest way to search and delete

[rholdren]

Good morning. I am looking for a faster (better) way of searching and deleting. I have a small piece of code, listed below. It runs perfectly fine but sometimes the worksheet I run this against is huge and it takes a very long time to run. It can be anywhere from 50 rows to over a hundred thousand. Is there a faster way to do the below. I am open to complete change of direction if it works faster.

Thanks in advance for any help.

Sheets("COMPOSITE").Select

Dim cell As range


For Each cell In range("L:L")
If cell.Value = "DIAGS OR PROCS" Then
cell.EntireRow.Delete
End If
Next cell

 

[Fluff]

One option is

Sub rholdren()
   With Range("L2", Range("L" & Rows.Count).End(xlUp))
      .Replace "DIAGS OR PROCS", True, xlWhole, , False, , False, False
      On Error Resume Next
      .SpecialCells(xlConstants, xlLogical).EntireRow.Delete
      On Error GoTo 0
   End With
End Sub

 

[Peter_SSs]

I suggest that you update your Account details (or click your user name at the top right of the forum) so helpers always know what Excel version(s) & platform(s) you are using as the best solution often varies by version. (Don’t forget to scroll down & ‘Save’)

Give this a try with a copy of your workbook. If you have lots of disjoint ranges to delete, this should be much faster.

Sub Del_Fast()
  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("L2", Range("L" & Rows.Count).End(xlUp)).Value
  ReDim b(1 To UBound(a), 1 To 1)
  For i = 1 To UBound(a)
    If a(i, 1) = "DIAGS OR PROCS" Then
      b(i, 1) = 1
      k = k + 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

 

[rholdren]

Thanks Fluff that worked. I've always heard and sometimes said, "Less is More" but in this case it was the opposite and it worked very well. Also thanks for the reminder about updating the file with the version. I just did that. I have 365 and 2019 (on an older laptop). I don't mind reminders. I have CRS disease since the mini-stroke. Thanks again.

 

[Peter_SSs]

Thanks Fluff that worked.

I agree, but you said you sometimes had very large data and were looking for the fastest way. Did you test Fluff's & mine on such a large data?
Or are all your "DIAGS OR PROCS" grouped together?

 

[Fluff]

Glad we could help & thanks for the feedback.
However the reminder was from Peter.

 

[rholdren]

Peter_SSs that was my Bad, I am sorry. Thank your for your response, it was actually yours I used. It worked perfectly. I really do appreciate the help.

 

[Peter_SSs]

No problem. I think both suggestions should work fine, but as I said before, if there are many disjoint rows to be deleted in a large data set there would be a significant difference in speed.

 

[termeric]

I suggest that you update your Account details (or click your user name at the top right of the forum) so helpers always know what Excel version(s) & platform(s) you are using as the best solution often varies by version. (Don’t forget to scroll down & ‘Save’)

Give this a try with a copy of your workbook. If you have lots of disjoint ranges to delete, this should be much faster.

Sub Del_Fast()
  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("L2", Range("L" & Rows.Count).End(xlUp)).Value
  ReDim b(1 To UBound(a), 1 To 1)
  For i = 1 To UBound(a)
    If a(i, 1) = "DIAGS OR PROCS" Then
      b(i, 1) = 1
      k = k + 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

Hi Peter_SSs, is there a way to change this so that instead of deleting anything "DIAGS OR PROCS", it deletes anything that doesn't contain "DIAGS"?

I've tried changing

     If a(i, 1) = "DIAGS OR PROCS" Then

to

    If a(i, 1) <> "DIAGS" & "*" Then

and to

    If a(i, 1) like "DIAGS" & "*" Then

but have had no success

 

[Fluff]

Try

If Not a(i, 1) Like "DIAGS*" Then