XSFormatCleaner errors with 'Application-defined or object-defined error'. The command that fails is the 'ur.clear' as the 'Msgbox 1' command never gets executed.

Code:
Sub ClearExcessRowsAndColumns()
   Dim ar As Range, r As Double, c As Double, tr As Double, tc As Double
   Dim wksWks As Worksheet, ur As Range, arCount As Integer, i As Integer
   Dim blProtCont As Boolean, blProtScen As Boolean, blProtDO As Boolean
   Dim shp As Shape

   On Error Resume Next
   For Each wksWks In ActiveWorkbook.Worksheets
      Err.Clear
      'Store worksheet protection settings and unprotect if protected.
      blProtCont = wksWks.ProtectContents
      blProtDO = wksWks.ProtectDrawingObjects
      blProtScen = wksWks.ProtectScenarios
      wksWks.Unprotect ""
      If Err.Number = 1004 Then
         Err.Clear
         MsgBox "'" & wksWks.Name & _
               "' is protected with a password and cannot be checked." _
               , vbInformation
      Else
         Application.StatusBar = "Checking " & wksWks.Name & ", Please Wait..."
         r = 0
         c = 0

         'Determine if the sheet contains both formulas and constants
         Set ur = Union(wksWks.UsedRange.SpecialCells(xlCellTypeConstants), _
               wksWks.UsedRange.SpecialCells(xlCellTypeFormulas))
         'If both fails, try constants only
         If Err.Number = 1004 Then
            Err.Clear
            Set ur = wksWks.UsedRange.SpecialCells(xlCellTypeConstants)
         End If
         'If constants fails then set it to formulas
         If Err.Number = 1004 Then
            Err.Clear
            Set ur = wksWks.UsedRange.SpecialCells(xlCellTypeFormulas)
         End If
         'If there is still an error then the worksheet is empty
         If Err.Number <> 0 Then
            Err.Clear
            If wksWks.UsedRange.Address <> "$A$1" Then
               ur.EntireRow.Delete
            Else
               Set ur = Nothing
            End If
         End If
         'On Error GoTo 0
         If Not ur Is Nothing Then
            arCount = ur.Areas.Count
            'determine the last column and row that contains data or formula
            For Each ar In ur.Areas
               i = i + 1
               tr = ar.Range("A1").Row + ar.Rows.Count - 1
               tc = ar.Range("A1").Column + ar.Columns.Count - 1
               If tc > c Then c = tc
               If tr > r Then r = tr
            Next
            'Determine the area covered by shapes
            'so we don't remove shading behind shapes
            For Each shp In wksWks.Shapes
               tr = shp.BottomRightCell.Row
               tc = shp.BottomRightCell.Column
               If tc > c Then c = tc
               If tr > r Then r = tr
            Next
            Application.StatusBar = "Clearing Excess Cells in " & _
                  wksWks.Name & ", Please Wait..."

            Set ur = wksWks.Rows(r + 1 & ":" & wksWks.Rows.Count)
            ur.Clear
   MsgBox 1
            'Reset row height which can also cause the lastcell to be innacurate
            ur.EntireRow.RowHeight = _
                  wksWks.StandardHeight
            Set ur = wksWks.Range(wksWks.Cells(1, c + 1), _
                  wksWks.Cells(1, 256)).EntireColumn
            'Reset column width which can also cause the lastcell to be innacurate
            ur.EntireColumn.ColumnWidth = _
                  wksWks.StandardWidth
         End If
      End If
      'Reset protection.
      wksWks.Protect "", blProtDO, blProtCont, blProtScen
      Err.Clear
   Next
   Application.StatusBar = False
   MsgBox "'" & ActiveWorkbook.Name & _
         "' has been cleared of excess formatting." & Chr(13) & _
         "You must save the file to keep the changes.", vbInformation
End Sub
Please help. Thanks.