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]

In that case use

Sub ChkErrors()
   Dim Ws As Worksheet
   Dim i As Long, x As Long
   i = 65
   Sheets("Input data").Unprotect "***"
   For Each Ws In Worksheets
      Ws.Unprotect "***"
      Sheets("Input data").Range("A" & i).Value = Ws.Name
      On Error Resume Next
      x = Ws.UsedRange.SpecialCells(xlFormulas, xlErrors).Areas.Count
      On Error GoTo 0
      Sheets("Input data").Range("A" & i).Interior.Color = IIf(x > 0, 255, 52879836)
      i = i + 1
      Ws.Protect "***"
   Next Ws
   Sheets("Input data").Protect "***"
End Sub

 

[Daniel89]

Now I get the fault:

runtime error 1004 ,
Application-defined or object-defined error


This is my code:

Public Sub errorchk()
 Dim Ws As Worksheet
   Dim i As Long, x As Long
   i = 65
   Sheets("Input data").Unprotect "password"
   For Each Ws In Worksheets
      Ws.Unprotect "password"
      Sheets("Input data").Range("O66").Value = Ws.Name
      On Error Resume Next
      x = Ws.UsedRange.SpecialCells(xlFormulas, xlErrors).Areas.Count
      On Error GoTo 0
      Sheets("Input data").Range("AQ66").Interior.Color = IIf(x > 0, 255, 65280)
      i = i + 1
      Ws.Protect "password"
   Next Ws
   Sheets("Input data").Protect "password"
End Sub

in the cell that Ws. name is referring to now says Input data, the other cell with colour says status OK(green)

 

[Fluff]

Try

   Dim Ws As Worksheet
   Dim i As Long, x As Long
   i = 66
   Sheets("Input data").Unprotect "***"
   For Each Ws In Worksheets
      If Ws.Name <> "Input data" Then
         Ws.Unprotect "***"
         Sheets("Input data").Range("O" & i).Value = Ws.Name
         On Error Resume Next
         x = Ws.UsedRange.SpecialCells(xlFormulas, xlErrors).Areas.Count
         On Error GoTo 0
         Sheets("Input data").Range("AQ" & i).Interior.Color = IIf(x > 0, 255, 52879836)
         i = i + 1
         Ws.Protect "***"
      Next Ws
   Next Ws
   Sheets("Input data").Protect "***"
End Sub

Because you have hardcoded the ranges O66 & AQ66, you will only get the result from the last sheet in the workbook

 

[Daniel89]

Aha, learning something new every step here

Now the fault code is compiler error:

Next without For

 

[Fluff]

I'm not surprised. Got it slightly wrong, it should be

         Ws.Protect "***"
      [COLOR=#ff0000]End If[/COLOR]
   Next Ws

 

[Daniel89]

thank you, I do not get any fault messages now.

But in the cell where Ws.name is to be input , if there is no fault, the text that was already there is there still. Is it possible to get the macro to delete text if there is no fault?

And what range in the worksheets does the macro searches for, I tried to place som #Div/0 faults in some of the sheets, but it didn't find them, but it did find in one sheet where the sign # was typed...

 

[Fluff]

Make this change

         Ws.Unprotect "***"
         On Error Resume Next
         x = Ws.UsedRange.SpecialCells(xlFormulas, xlErrors).Areas.Count
         On Error GoTo 0
         Sheets("Input data").Range("O" & i).Value = IIf(x > 0, Ws.Name, "")
         Sheets("Input data").Range("AQ" & i).Interior.Color = IIf(x > 0, 255, 52879836)
         i = i + 1

to only add the sheet name if there are errors.
Are your errors as the result of Formulae?

 

[Daniel89]

Yes, I am looking for errors as results of formulas gone wrong, #Value , #DIV/0 etc.

 

[Fluff]

Do the sheet names come through for every sheet, or just some?

 

[Daniel89]

I don't know what the issue is, but the function does not find errors, I have tried to put in some #DIV/0 errors in some of the sheets. but the sub doesn't colour the cell red and doesn't write any sheet name in the specified cell. It only finds errors in one of the sheets.

Is it possible to write a "simpler" code which names all sheets. One of the sheets actually needs to be unprotected. so no password for that sheet...