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

D

Daniel89

New Member
Joined
Mar 14, 2018
Messages
26
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:
Code: 
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.

Code: 
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!
 
Last edited:

Excel Facts

Will the fill handle fill 1, 2, 3?
Yes! Type 1 in a cell. Hold down Ctrl while you drag the fill handle.
Sort by date Sort by votes
At the moment you're overwriting the Input data sheet A65:BD66 for each sheet you test, so you will only get the result from the last sheet.
Try
Code: 
Sub ChkErrors()
   Dim Ws As Worksheet
   Dim i As Long, x As Long
   i = 65
   For Each Ws In Worksheets
      Sheets("new").Range("A" & i).Value = Ws.Name
      On Error Resume Next
      x = Ws.UsedRange.SpecialCells(xlFormulas, xlErrors).Areas.Count
      On Error GoTo 0
      Sheets("new").Range("A" & i).Interior.Color = IIf(x > 0, 255, 52879836)
      i = i + 1
   Next Ws
End Sub
This will put the sheet name in A65 downwards & highlight the name in either colour.
 
Upvote 0
Thx a lot for your time!

So This is my code now:
Code: 
Sub ChkErrors()
   Dim Ws As Worksheet
   Dim i As Long, x As Long
   i = 65
   For Each Ws In Worksheets
      Sheets("new").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("A65").Interior.Color = IIf(x > 0, 255, 52879836)
      i = i + 1
   Next Ws
End Sub

what should I put in:
Code: 
 For Each Ws In Worksheets
      Sheets("new").Range("A" & i).Value = Ws.Name

When I use the macro now I get error, subscript out of range.
 
Upvote 0
And I haven't mentioned a detail that might affect the choice of method; all the sheets that shall be error checked must stay protected.
 
Upvote 0
Try
Code: 
Sub ChkErrors()
   Dim Ws As Worksheet
   Dim i As Long, x As Long
   i = 65
   For Each Ws In Worksheets
      Ws.Unprotect "[COLOR=#ff0000]***[/COLOR]"
      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("A65").Interior.Color = IIf(x > 0, 255, 52879836)
      i = i + 1
      Ws.Protect "[COLOR=#ff0000]***[/COLOR]"
   Next Ws
End Sub
Change the parts in red to your password
 
Upvote 0
OK, so I should make it like this, I put A1:Z1000 as an example, sorry for silly questions I am really new to VBA...

Code: 
Sub ChkErrors()
   Dim Ws As Worksheet
   Dim i As Long, x As Long
   i = 65
   For Each Ws In Worksheets
      Ws.Unprotect "[COLOR=#ff0000]***[/COLOR]"
      Sheets("Sheet1 to be checked").Range("A1:Z100" & i).Value = Ws.Name
      On Error Resume Next
      x = Ws.UsedRange.SpecialCells(xlFormulas, xlErrors).Areas.Count
      On Error GoTo 0
      Sheets("Input data").Range("A65").Interior.Color = IIf(x > 0, 255, 52879836)
      i = i + 1
      Ws.Protect "[COLOR=#ff0000]***[/COLOR]"
   Next Ws

 For Each Ws In Worksheets
      Ws.Unprotect "[COLOR=#ff0000]***[/COLOR]"
      Sheets("Sheet2 to be checked").Range("A1:Z100" & i).Value = Ws.Name
      On Error Resume Next
      x = Ws.UsedRange.SpecialCells(xlFormulas, xlErrors).Areas.Count
      On Error GoTo 0
      Sheets("Input data").Range("A65").Interior.Color = IIf(x > 0, 255, 52879836)
      i = i + 1
      Ws.Protect "[COLOR=#ff0000]***[/COLOR]"
   Next Ws

For Each Ws In Worksheets
      Ws.Unprotect "[COLOR=#ff0000]***[/COLOR]"
      Sheets("Sheet¨3 to be checked").Range("A1:Z100" & i).Value = Ws.Name
      On Error Resume Next
      x = Ws.UsedRange.SpecialCells(xlFormulas, xlErrors).Areas.Count
      On Error GoTo 0
      Sheets("Input data").Range("A65").Interior.Color = IIf(x > 0, 255, 52879836)
      i = i + 1
      Ws.Protect "[COLOR=#ff0000]***[/COLOR]"
   Next Ws

End Sub
 
Upvote 0
Just change the *** to your password & run the code I supplied in post#5, does it do what you want?
 
Upvote 0
I get runtime error '1004':
The cell or chart you're trying to change is on a protected sheet.
To make changes, click Unprotect Sheet...........

The correct password is entered, and the password is the same on all sheets...

don't know why it isn't working, when I remove the passwords lines I get no faults, but in the cell
Code: 
Sheets("Input data").Range("AQ66").Interior.Color = IIf(x > 0, 255, 65280)
this line is referring to gets green (status OK colour)

In the cell which this codeline is referring to, the last worksheet name is written, but no errors is found.

Code: 
Sheets("Input data").Range("O66").Value = Ws.Name
 
Upvote 0
Is the "Input data" sheet protected?
 
Upvote 0
You must log in or register to reply here.

Similar threads

C
  • Solved
Protecting all cells in a sheet based on .TintAndShade
Replies
4
Views
91
Peter_SSs
Peter_SSs
B
  • Solved
Object required error
Replies
2
Views
142
Boston_Paul
B
K
  • Solved
formating question
Replies
3
Views
312
Micron
M
J
  • Question Question
Macro to affect cell background color
Replies
3
Views
404
mumps
mumps
E
  • Solved
How to Loop through code
Replies
3
Views
295
dreid1011
dreid1011

Forum statistics

Threads
1,223,911
Messages
6,175,335
Members
452,636
Latest member
laura12345

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top