Macro for Replacing Text Produces Run-Time Error 91

Hi! I have a macro that works fine and with no errors if there is a single instance of a string--" Total"--found within a cell in column D. It also works until the string can no longer be found, but once all the values of " Total" have been found and replaced, the macro stops and the following error pops up: "Run-time error '91': Object variable or With block variable not set." The debug option pops up at the point in the code highlighted in blue below, and is obviously related to not finding " Total" in column D.

I have searched and searched for code and keep trying to modify the macro to eliminate the error, but with no success. I'd like this this macro to run automatically on each worksheet as they are created rather than going to each worksheet and running the macro separately. Although this is a workaround that will produce the desired formatting of the worksheets, it is more time-consuming.

Any help you can offer will be greatly appreciated after spending MANY hours trying to fix this! I am not locked into any of the code other than that needed for the formatting.

Thanks in advance!

Sub ERSubtotalsByRegion2()
'
Dim FoundCell As Range, LastCell As Range
Dim FirstAddr As String
'set the search range:
With Range("D3:D3000")
Range("D3").Select
   Set LastCell = .Cells(.Cells.Count)
End With
   Set FoundCell = Range("D1:D3000").Find(What:=" Total", After:=LastCell, LookIn:=xlValues, _
   LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
   If Not FoundCell Is Nothing Then
      'saves the address of the first occurrence of " Total", in the strFirstAddress variable:
      FirstAddr = FoundCell.Address
      End If
      Do Until FoundCell Is Nothing
         Debug.Print FoundCell.Address
         Set FoundCell = Range("D1:D3000").FindNext(After:=FoundCell)
    COLUMNS("D:D").Select
    Selection.Find(What:=" Total", After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate
    ActiveCell.Rows("1:1").EntireRow.Select
    ActiveCell.Offset(0, 0).Range("A1:AR1").Select
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThick
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThick
    End With
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    'ActiveCell.Activate
    Selection.Font.Bold = True
    ActiveCell.Offset(-1, 0).Rows("1:1").EntireRow.Select
    With Selection.Interior
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = -4.99893185216834E-02
        .PatternTintAndShade = 0
    End With
  COLUMNS("D:D").Select
  Selection.Find(What:=" Total", After:=ActiveCell, LookIn:=xlFormulas, _
      LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
      MatchCase:=False, SearchFormat:=False).Activate
  ActiveCell.Replace What:="Total", Replacement:="", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    If FoundCell.Address = FirstAddr Then
       Exit Do
    End If
  Loop
End Sub