Excel VBA 4 step macro not executing last step - Range Error

Question

I have the below which is made of several queries that I want to run in order but it appears that when I get to the last one it doesn't delete (tho the delete by itself works) can anyone help with this?

Desired Behavior: Take some data on multiple sheets Then Freeze the first row Then Format it as a Table Then resize, center and wrap text Then search through all sheets and delete any row where the word "completed" exists.

Specific Problem: It appeared that it was not doing the final step (removing all rows with the word completed) Actually it was erring on the row rDelete.EntireRow.Delete by stating "range error"

Shortest Code to Reproduce: I think the below is the shortest code, other than just eliminating all but the last macro, but I am not sure if that would create other errors when trying to reproduce results.

Hope this addresses Mat's Mug's Comment below and is in line with the Minimal, Complete, and Verifiable example.

Sub TEST()
'
' Freeze_Panes Macro
'
' This one Freezes Row 1 (under Header)
    Dim s As Worksheet
    Dim c As Worksheet
' store current sheet
    Set c = ActiveSheet
' Stop flickering...
    Application.ScreenUpdating = False
' Loop throught the sheets
    For Each s In ActiveWorkbook.Worksheets

' Have to activate - SplitColumn and SplitRow are properties of ActiveSheet
    s.Activate

    With ActiveWindow
        .SplitColumn = 0
        .SplitRow = 1
'   .SplitRow = 2 'Depending on if it has a header maybe?
        .FreezePanes = True
    End With

    Next
' Back to original sheet
    c.Activate
    Application.ScreenUpdating = True

    Set s = Nothing
    Set c = Nothing
Call Format_As_Table
End Sub
Private Sub Format_As_Table()
'
' Format_As_Table Macro
'
' Declaration
Dim Tbl As ListObject
Dim Rng As Range
Dim sh As Worksheet

Application.ScreenUpdating = False
' Loop Through All Sheets and Format All Data as Table, then Orient as Landscape
For Each sh In ActiveWorkbook.Sheets
    With sh
        Set Rng = .Range(.Range("A1"), .Range("A1").SpecialCells(xlLastCell))
        Set Tbl = .ListObjects.Add(xlSrcRange, Rng, , xlYes)
        Tbl.TableStyle = "TableStyleMedium15"

        .PageSetup.Orientation = xlLandscape
    End With

Next sh
Application.ScreenUpdating = False
Call Resize_Columns_And_Rows_No_Header
End Sub
Private Sub Resize_Columns_And_Rows_No_Header()
'
'Resize_Columns_And_Rows Macro
'
'Declaration
  Dim wkSt As String
  Dim wkBk As Worksheet
  Dim temp As Variant
  Dim lastCol As Long

  wkSt = ActiveSheet.Name
' This Loops Through All Sheets
  For Each wkBk In ActiveWorkbook.Worksheets
      On Error Resume Next
      wkBk.Activate
      lastCol = wkBk.Cells(1, Columns.Count).End(xlToLeft).Column
'This is only needed if you are wrapping the text
      wkBk.Rows.WrapText = True
'This is to center align all rows
      'wkBk.Rows.VerticalAlignment = xlCenter
      wkBk.Rows.HorizontalAlignment = xlCenter
'Resize Columns due to size
      wkBk.Columns("F:F").ColumnWidth = 50
      wkBk.Columns("G:G").ColumnWidth = 50
' Resize Rows
      wkBk.Rows.EntireRow.AutoFit
' Resize Columns
      wkBk.Columns.EntireColumn.AutoFit
  Next wkBk
  Sheets(wkSt).Select
Call TestDeleteRows
End Sub

Private Sub TestDeleteRows()
Dim rFind As Range
Dim rDelete As Range
Dim strSearch As String
Dim sFirstAddress As String
Dim sh As Worksheet

strSearch = "Completed"
Set rDelete = Nothing

Application.ScreenUpdating = False
For Each sh In ActiveWorkbook.Sheets
With sh.Columns("A:AO")
Set rFind = .Find(strSearch, LookIn:=xlValues, LookAt:=xlPart, SearchDirection:=xlNext, MatchCase:=False)
If Not rFind Is Nothing Then
    sFirstAddress = rFind.Address
    Do
        If rDelete Is Nothing Then
            Set rDelete = rFind
        Else
            Set rDelete = Application.Union(rDelete, rFind)
        End If
        Set rFind = .FindNext(rFind)
    Loop While Not rFind Is Nothing And rFind.Address <> sFirstAddress

    rDelete.EntireRow.Delete
    Set rDelete = Nothing
End If
End With
Next sh
Application.ScreenUpdating = False
End Sub

Answer 1

It seems like you are working out a solution in the comments already. However, I just thought I'd mention the following:

Excel does not like it when you overlap selections and attempt to delete them. If you have the word "Completed" in multiple cells on the same row, you end up with an overlap with rDelete.EntireRow.Delete . Instead of creating a union of each cell that has "Complete" you should simple create a union of each ROW.

This can be done easily by changing

Set rDelete = Application.Union(rDelete, rFind)

to

Set rDelete = Application.Union(rDelete, Range("A" & rFind.Row))

This ultimately results in trying to union A1 with A1 (or whichever row) and does not create a duplicated reference in the range rDelete.