[RESOLVED] XSFormatCleaner errors - Excel 2007

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.