Using VBA to remove row based on words listed in another sheet - slow performance

Question

I have a sheet (sheet1) with a large amount of data. This data has several columns, one of which is called nameColumn. nameColumn contains a single word per row.

In shee

Answer 1

See the comments in the following code. It creates a temporary array-formula in a column to the right of Sheet1. It's 20 columns to the right of the column we are checking - increase this number if necessary.

Sub DeleteAcross2()
    Dim calc As Variant
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Dim rng1 As Range
    Dim rng2 As Range
    Dim dels As Variant
    Dim x As Long
    Dim rngDel As Range

    Application.ScreenUpdating = False
    'remember the Calculation Mode to reinstate later
    calc = Application.Calculation
    Application.Calculation = xlCalculationManual

    Set ws1 = Worksheets("Sheet1")
    Set rng1 = ws1.Range("B2:B70")      'change this range
    Set ws2 = Worksheets("Sheet2")
    Set rng2 = ws2.Range("A1:A4")       'change this range

    'add a formula-column 20 columns to the right - increase this number if necessary
    rng1.Offset(0, 20).FormulaArray = "=ISNA(MATCH(Sheet1!$B$2:$B$70,Sheet2!$A$1:$A$4,0))"
    'creates a column of True/False values - we will delete rows with False
    dels = rng1.Offset(0, 20).Value
    For x = 1 To UBound(dels, 1)
        If dels(x, 1) = False Then
            If rngDel Is Nothing Then
                Set rngDel = rng1.Cells(x, 1)       'the first cell
            Else
                Set rngDel = Union(rngDel, rng1.Cells(x, 1))
            End If
        End If
    Next x
    rng1.Offset(0, 20).Clear        'remove the array-formula (required)
    If rngDel Is Nothing Then Exit Sub      'no matches found
    rngDel.EntireRow.Delete
    Application.Calculation = calc
    Application.ScreenUpdating = True
End Sub

It won't take 20 minutes to run :)