Delete rows in spreadsheet where cells match some patterns

I have vba code that loops through a large number of records and deletes rows based on criteria. The issue at hand is that it takes far too long to run. I have never actually let it finish because it takes so long (about five minutes puts it around row 700 out of ~250000). Basically, I need to loop through and see if cell contents contain the string template (or some variation as shown in code below) and if so delete that row.

First Attempt

lr = sht.Cells(Rows.Count, 1).End(xlUp).Row 'LastRow
For i = lr To 2 Step -1
    If sht.Cells(i, 1).Value Like "*template*" Or sht.Cells(i, 1).Value Like "*TEMPLATE*" _
    Or sht.Cells(i, 1).Value Like "*Template*" Or _
    sht.Cells(i, 3).Value Like "*template*" Or sht.Cells(i, 3).Value Like "*TEMPLATE*" _
    Or sht.Cells(i, 3).Value Like "*Template*" Then
        sht.Cells(i, 1).EntireRow.delete
    End If
Next i

but after This Post on SO, I tried reworking it.

Second Attempt (and currently in use)

Dim delete as Range
Set delete = Nothing
Set myRange = sht.Range("A2", sht.Cells(lr, 1))
For Each myCell In myRange
    If myCell.Value Like "*template*" Or myCell.Value Like "*TEMPLATE*" _
    Or myCell.Value Like "*Template*" Or myCell.Offset(0, 2).Value Like "*template*" _
    Or myCell.Offset(0, 2).Value Like "*TEMPLATE*" _
    Or myCell.Offset(0, 2).Value Like "*Template*" Then
        If Not delete Is Nothing Then
            Set delete = Union(delete, myCell)
        Else
            Set delete = myCell
        End If
    End If
Next myCell

If Not delete Is Nothing Then
    delete.EntireRow.delete
End If

Full Code (You asked for it....)

```
Public Sub EntitlementReport()

Application.ScreenUpdating = False

Dim accountBook As Workbook, entitlementsBk As Workbook, groupBk As Workbook
Dim wb As Workbook, final As Workbook
Dim sht As Worksheet
Dim aBkFound As Boolean, eBkFound As Boolean, gBkFound As Boolean

aBkFound = False
eBkFound = False
gBkFound = False

Set final = ActiveWorkbook
Set sht = final

You know what really speeds up vba? ARRAYS! Why do stuff on the sheet when you can do it in an array?

Option Explicit
Sub FindTemplate()

    Dim targetSheet As Worksheet
    Set targetSheet = Sheet1
    Dim lastRow As Long
    lastRow = targetSheet.Cells(Rows.Count, 1).End(xlUp).Row
    Dim myData As Variant
    myData = targetSheet.Range(Cells(1, 1), Cells(lastRow, 3))
    Dim myResults As Variant
    ReDim myResults(1 To lastRow, 1 To 3)
    Dim resultIndex As Long
    resultIndex = 1
    Dim index As Long
    For index = LBound(myData) To UBound(myData)
        If (InStr(1, myData(index, 1), "template", vbTextCompare) > 0) Or (InStr(1, myData(index, 3), "template", vbTextCompare) > 0) Then
            myResults(resultIndex, 1) = myData(index, 1)
            myResults(resultIndex, 2) = myData(index, 2)
            myResults(resultIndex, 3) = myData(index, 3)
            resultIndex = resultIndex + 1
        End If
    Next

    targetSheet.UsedRange.Clear
    targetSheet.Range(Cells(1, 1), Cells(resultIndex, 3)) = myResults

End Sub

StackExchange Code Review Q#155441, answer score: 11