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

Move date out one month or year
Use =EDATE(A2,1) for one month later. Use EDATE(A2,12) for one year later.
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

K
  • Solved
formating question
Replies
3
Views
64
Micron
M
J
  • Question
Macro to affect cell background color
Replies
3
Views
201
mumps
mumps
T
  • Question
Filling alternate cells with two colours?
Replies
3
Views
176
Joe4
Joe4
I
  • Solved
duplicating spreadsheet without losing formulas in cells
Replies
8
Views
210
MARK858
MARK858
B
  • Question
Finding excluded values in excel
Replies
0
Views
206
bcmk29
B

Forum statistics

Threads
1,214,522
Messages
6,120,020
Members
448,939
Latest member
Leon Leenders

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