VBA search funtion that find error cells in workbook and turns a "status cell" to green or red colour

[Daniel89]

Hei,

I would like to make a macro that searches the whole workbook for errors(#Value, #DIV/0, #Error etc.) and returns a cell either green (colour 5287936) if no errors found. or red(colour 255) if errors are found in workbook.

to make it easy I want to search for "#" as I do not have "#" appear in any other cells in the sheet. Therefore:

SearchString = "#" & Selected_sheet & "'!A1:BZ2000"

This is my code with my sheet names, but nothing happens even if i put a # in a cell in one of the sheets to test the sub.

Private Sub Errorcheck()
Dim Ret As Range
Selected_sheet = "Hydrostatic calculation sheet"
SearchString = "#" & Selected_sheet & "'!A1:BZ2000"
Set Ret = Search(Range(SearchString), "STARTING")
If Not Ret Is Nothing Then
        Sheets("Input data").Select
    Range("A65:BD66").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 255
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
Else
    Sheets("Input data").Select
    Range("A65:BD66").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 5287936
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
End If
Selected_sheet = "Main report"
SearchString = "#" & Selected_sheet & "'!A1:BZ2000"
Set Ret = Search(Range(SearchString), "STARTING")
If Not Ret Is Nothing Then
        Sheets("Input data").Select
    Range("A65:BD66").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 255
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
Else
    Sheets("Input data").Select
    Range("A65:BD66").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 5287936
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
End If
Selected_sheet = "Full calc report"
SearchString = "#" & Selected_sheet & "'!A1:BZ2000"
Set Ret = Search(Range(SearchString), "STARTING")
If Not Ret Is Nothing Then
        Sheets("Input data").Select
    Range("A65:BD66").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 255
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
Else
    Sheets("Input data").Select
    Range("A65:BD66").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 5287936
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
End If
Selected_sheet = "Pump Plot Data"
SearchString = "#" & Selected_sheet & "'!A1:BZ2000"
Set Ret = Search(Range(SearchString), "STARTING")
If Not Ret Is Nothing Then
        Sheets("Input data").Select
    Range("A65:BD66").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 255
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
Else
    Sheets("Input data").Select
    Range("A65:BD66").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 5287936
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
End If
Selected_sheet = "Compass file w. search function"
SearchString = "#" & Selected_sheet & "'!A1:BZ2000"
Set Ret = Search(Range(SearchString), "STARTING")
If Not Ret Is Nothing Then
        Sheets("Input data").Select
    Range("A65:BD66").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 255
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
Else
    Sheets("Input data").Select
    Range("A65:BD66").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 5287936
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
End If
Selected_sheet = "Input data"
SearchString = "#" & Selected_sheet & "'!A1:BZ2000"
Set Ret = Search(Range(SearchString), "STARTING")
If Not Ret Is Nothing Then
        Sheets("Input data").Select
    Range("A65:BD66").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 255
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
Else
    Sheets("Input data").Select
    Range("A65:BD66").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 5287936
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
End If
End Sub

I would highly appreciate help!

 

[Fluff]

If you change xlFormulas to xlConstants what happens?

 

[Daniel89]

It still doesn't find errors in the sheets except for one of the sheets named "user manual", maybe you could show me how to write all sheets specifically with name instead of the function for all ws, as I mentioned one of the sheets must be left unprotected. It doesn't need any error search either...

 

[Fluff]

There's no point in completely rewriting the code to look at sheet individually, when it isn't working.
To ignore another sheet use this

      If ws.Name <> "Input data" And ws.Name <> "[COLOR=#ff0000]Sheet1[/COLOR]" Then

change the value in red to suit.

Would you be willing to put your file on a share site such as OneDrive, DropBox & post a link to it?

 

[Fluff]

Ok, the code I supplied does work, it just that you have a load of buttons covering the output cells, so you cannot see the result.
One option, is to set the height of row66 to 90 & then run this

Public Sub errorchk()
Dim Ws As Worksheet
Dim Msg As String
Dim x As Long
Application.ScreenUpdating = False
Sheets("Input data").Unprotect "***"
For Each Ws In Worksheets
If Ws.Name <> "Input data" And Ws.Name <> "Well_Schematic" And Ws.Name <> "User Manual" Then
Ws.Unprotect "***"
         On Error Resume Next
         x = Ws.UsedRange.SpecialCells(xlFormulas, xlErrors).Areas.Count
         On Error GoTo 0
         If x > 0 Then If Len(Msg) = 0 Then Msg = Ws.Name Else Msg = Msg & vbLf & Ws.Name
Ws.Protect "***"
End If
Next Ws
If Len(Msg) Then
   Sheets("Input data").Range("O66").Value = Msg
   Sheets("Input data").Range("AQ66").Interior.Color = 255
End If
Sheets("Input data").Protect "***"
Sheets("Input data").Select
End Sub

 

[Daniel89]

Thank you very much Fluff! The function is working really well now

I added a small detail to make the function colour one of the cells green and the text cell blank if no errors is found.

My final and working code:

Public Sub errorchk()
Dim Ws As Worksheet
Dim Msg As String
Dim x As Long
Application.ScreenUpdating = False
Sheets("Input data").Unprotect "***"
For Each Ws In Worksheets
If Ws.Name <> "Input data" And Ws.Name <> "Well_Schematic" And Ws.Name <> "User Manual" Then
Ws.Unprotect "***"
         On Error Resume Next
         x = Ws.UsedRange.SpecialCells(xlFormulas, xlErrors).Areas.Count
         On Error GoTo 0
         If x > 0 Then If Len(Msg) = 0 Then Msg = Ws.Name Else Msg = Msg & vbLf & Ws.Name
Ws.Protect "***"
End If
Next Ws
If Len(Msg) Then
   Sheets("Input data").Range("O66").Value = Msg
   Sheets("Input data").Range("AQ66").Interior.Color = 255
   Else
   Sheets("Input data").Range("O66").Value = ""
   Sheets("Input data").Range("AQ66").Interior.Color = 5287936
End If
Sheets("Input data").Protect "***"
Sheets("Input data").Select
End Sub

 

[Fluff]

Glad to help & thanks for the feedback