VBA works on One Sheet I need it to work on All Sheets

[Myproblem]

I have VBA code under which find all errors on sheet, the Code is Working OK.
I need to modify the Same code to work on all Sheets in one workbook, OR to get list of all errors in all sheets, OR to get list of all errors in all sheets with another VBA code
any idea?

ps original code from ozgrid

Sub All_Errors()
Dim rCcells As Range, rFcells As Range
Dim rAcells As Range

'Set variable to all used cells
Set rAcells = ActiveSheet.UsedRange
On Error Resume Next 'In case of no numeric formula or constants.
'Set variable to all numeric constants
Set rCcells = rAcells.SpecialCells(xlCellTypeConstants, xlErrors)
'Set variable to all numeric formulas
Set rFcells = rAcells.SpecialCells(xlCellTypeFormulas, xlErrors)
'Determine which type of numeric data (formulas, constants or none)
If rCcells Is Nothing And rFcells Is Nothing Then
MsgBox "You Worksheet contains no numbers"
End
ElseIf rCcells Is Nothing Then
Set rAcells = rFcells 'formulas
ElseIf rFcells Is Nothing Then
Set rAcells = rCcells 'constants
Else
Set rAcells = Application.Union(rFcells, rCcells) 'Both
End If
On Error GoTo 0
rAcells.Select
End Sub

 

[tigeravatar]

Myproblem,

Give the following a try:

Sub All_Errors()
    
    Dim ws As Worksheet
    Dim rngConst As Range
    Dim rngFrmla As Range
    
    On Error Resume Next
    For Each ws In ActiveWorkbook.Sheets
        
        Set rngConst = Nothing
        Set rngFrmla = Nothing
            
        Set rngConst = ws.UsedRange.SpecialCells(xlCellTypeConstants, xlErrors)
        Set rngFrmla = ws.UsedRange.SpecialCells(xlCellTypeFormulas, xlErrors)
        
        If rngConst Is Nothing And rngFrmla Is Nothing Then
            MsgBox ws.Name & " contains no numbers"
        ElseIf rngConst Is Nothing Then
            rngFrmla.Select
        ElseIf rngFrmla Is Nothing Then
            rngConst.Select
        Else
            Union(rngConst, rngFrmla).Select
        End If
    Next ws
    
End Sub

Hope that helps,
~tigeravatar

 

[Myproblem]

i tried, but i did not get any better result than my original code
thanks tiger

any other idea

 

[tigeravatar]

Myproblem,

I ran it on a test workbook, and it ran successfuly for me for all sheets. The code selects error cells and gives a message for each worksheet that does not contain any errors. So when you go through each worksheet after the code has run, the cells with errors are selected. Would you prefer something more obvious, like highlighting error cells red?

 

[Myproblem]

Myproblem,

I ran it on a test workbook, and it ran successfuly for me for all sheets. The code selects error cells and gives a message for each worksheet that does not contain any errors. So when you go through each worksheet after the code has run, the cells with errors are selected. Would you prefer something more obvious, like highlighting error cells red?

dear tiger,
you are right, it does everything you said i would prefer some kind of list on new sheet with all errors, and their cell address

 

[tigeravatar]

Myproblem,

Updated code to create a new worksheet, and list all errors and their cell addresses in the new worksheet:

Sub All_Errors()
    
    Static wsNew As Worksheet: Set wsNew = Sheets.Add(After:=Sheets(Sheets.Count))
    
    Dim ws As Worksheet
    Dim arrRslt() As Variant
    Dim arrIndex As Long
    Dim rngDest As Range
    Dim rngConst As Range, rngFrmla As Range
    Dim rngError As Range, ErrorCell As Range
    
    ReDim arrRslt(1 To 2, 1 To 2): arrRslt(1, 1) = "Sheet: "
                                   arrRslt(1, 2) = "Error"
                                   arrRslt(2, 2) = "Cell"
    
    On Error Resume Next
    For Each ws In ActiveWorkbook.Sheets
        If ws.Name <> wsNew.Name Then
            arrRslt(2, 1) = ws.Name
            arrIndex = 2
            Set rngConst = Nothing
            Set rngFrmla = Nothing
            Set rngError = Nothing
            Set rngDest = wsNew.Cells(1, Columns.Count).End(xlToLeft).Offset(0, 2)
            
            Set rngConst = ws.UsedRange.SpecialCells(xlCellTypeConstants, xlErrors)
            Set rngFrmla = ws.UsedRange.SpecialCells(xlCellTypeFormulas, xlErrors)
            
            If rngConst Is Nothing And rngFrmla Is Nothing Then
                rngDest.Resize(1, 2).Value = Array(ws.Name, "No error cells found")
            ElseIf rngConst Is Nothing Then
                Set rngError = rngFrmla
            ElseIf rngFrmla Is Nothing Then
                Set rngError = rngConst
            Else
                Set rngError = Union(rngConst, rngFrmla)
            End If
            
            If rngError Is Nothing Then
                ReDim Preserve arrRslt(1 To 2, 1 To 3)
                arrRslt(1, 3) = "No Errors"
                arrRslt(2, 3) = "No error cells found"
            Else
                ReDim Preserve arrRslt(1 To 2, 1 To rngError.Cells.Count + 2)
                For Each ErrorCell In rngError
                    arrIndex = arrIndex + 1
                    arrRslt(1, arrIndex) = ErrorCell.Text
                    arrRslt(2, arrIndex) = ErrorCell.Address
                Next ErrorCell
            End If
            rngDest.Resize(UBound(arrRslt, 2), 2).Value = WorksheetFunction.Transpose(arrRslt)
        End If
    Next ws
    
    wsNew.[A:B].Delete
    wsNew.UsedRange.EntireColumn.AutoFit
    
End Sub

Hope that helps,
~tigeravatar

 

[Myproblem]

man, you are my man
it rocks, thanks tiger, it is what i mean to get

wish you nice day or succesfull night