Delete rows which do not meet specific criteria (text values)

I have a really wierd issue with excel. I am trying to eliminate my longdatabase, rows are 170,000. This code doesnt work

Sub Delete_Rows_ColB()

Dim rng As Range, cell As Range, del As Range
Dim strCellValue As String
Set rng = Intersect(Range("D:D"), ActiveSheet.UsedRange)
For Each cell In rng
 
If (InStr(strCellValue, "ELF") > 0 Or InStr(strCellValue, "OLEP") > 0) Then
  If del Is Nothing Then
  Set del = cell
  Else: Set del = Union(del, cell)
  End If
End If
Next cell
On Error Resume Next
del.EntireRow.Delete
End Sub

while this code works fine:

Sub Delete_Rows_ColB()

Dim rng As Range, cell As Range, del As Range
Dim strCellValue As String
Set rng = Intersect(Range("D:D"), ActiveSheet.UsedRange)
For Each cell In rng
 
If InStr(strCellValue, "ELF") Or InStr(strCellValue, "OLEP") Then
  If del Is Nothing Then
  Set del = cell
  Else: Set del = Union(del, cell)
  End If
End If
Next cell
On Error Resume Next
del.EntireRow.Delete
End Sub

As you see, the two codes return different outcome. The first (doesnt work) keeps only the rows with ELF or OLEP and the second deletes them.

Any help of how i can tweak my first code?

thanks a lot

try

Sub Delete_Rows_ColB()
Dim rng As Range, r As Range, del As Range
Dim strCellValue As String
Set rng = Intersect(Range("D:D"), ActiveSheet.UsedRange)
For Each r In rng
    If InStr(r.Value, "ELF") Or InStr(r.Value, "OLEP") Then
        If del Is Nothing Then
            Set del = r
        Else: Set del = Union(del, r)
        End If
    End If
Next r
If Not del Is Nothing Then del.EntireRow.Delete
End Sub