Sub ClearAllErrors()
Dim CellFormula As String
If TypeName(Selection) <> "Range" Then
MsgBox "Please select a range of cells.", vbInformation + vbOKOnly, "Invalid Range Selection"
Exit Sub
End If
On Error GoTo exitsub
intResponse = MsgBox("This macro will adjust all formulas in the currently selected cells" & vbCrLf & "so that they will not display error messages.", vbOKCancel, "Clear Error Messages")
If intResponse = vbOK Then
Application.ScreenUpdating = False
If Selection.Rows.Count = 65536 Then SelectFirstCellLastCell
Set rngMyRange = Selection '.SpecialCells(xlCellTypeFormulas)
'MsgBox rngMyRange.Address
For Each cell In rngMyRange
' If IsError(Cell.Value) Then
CellFormula = "'" & cell.Formula
CellFormula = Right(CellFormula, Len(CellFormula) - 2)
cell.Formula = "=IF(ISERROR(" & CellFormula & "),""""," & CellFormula & ")"
' End If
Next cell
Application.ScreenUpdating = True
End If
exitsub:
On Error GoTo 0
End Sub
Sub SelectFirstCellLastCell()
Dim LastRow As Long, LastCol As Long
Set rngMyRange = Selection
With rngMyRange
' Find the last real row
LastRow = .Cells.Find(What:="*", _
SearchDirection:=xlPrevious, _
SearchOrder:=xlByRows).Row
' Find the last real column
LastCol = .Cells.Find(What:="*", _
SearchDirection:=xlPrevious, _
SearchOrder:=xlByColumns).Column
End With
Range(Cells(ActiveCell.Row, ActiveCell.Column), Cells(LastRow, LastCol)).Select
End Sub