Macro to run on multiple excel files find if any #N/A , #NAME?, #VALUE!

JAVEDR

Board Regular
Joined
Sep 17, 2019
Messages
79
Office Version
  1. 2019
Platform
  1. Windows
  2. Mobile
  3. Web
Hello Sir/Madam,

I have multiple excel files in folder contains multiple sheets. I'm looking for macro to run on those and find if any #N/A , #NAME?, #VALUE!, #REF! and provide excel name if any contains this.
 

Excel Facts

Formula for Yesterday
Name Manager, New Name. Yesterday =TODAY()-1. OK. Then, use =YESTERDAY in any cell. Tomorrow could be =TODAY()+1.
This code will loop through all the files within a folder. It will check for errors in each sheet. It will insert an "Errors" page to the end of each workbook. "Errors" sheet will include sheets names containing errors and number of errors.
I have tested the report part. It is working. But I didn't check the file looping part. You may need to fiddle around with the code. At least this may be a good start point for you:
VBA Code:
Sub CountErrors()
  Dim wb As Workbook
  Dim myPath As String
  Dim myFile As String
  Dim myExtension As String
  Dim FldrPicker As FileDialog

  Application.ScreenUpdating = False
  Application.EnableEvents = False
  Application.Calculation = xlCalculationManual

  Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)

    With FldrPicker
      .Title = "Select A Target Folder"
      .AllowMultiSelect = False
        If .Show <> -1 Then GoTo NextCode
        myPath = .SelectedItems(1) & "\"
    End With

NextCode:
  myPath = myPath
  If myPath = "" Then GoTo ResetSettings
  myExtension = "*.xls*"
  myFile = Dir(myPath & myExtension)
  Do While myFile <> ""
  'Code is working hereinafter. Haven't tested before this point.
    Set wb = Workbooks.Open(Filename:=myPath & myFile)

    Dim ws As Worksheet
    Dim Errors As Long
    Dim SheetCount As Integer
    Dim i As Long
    Dim ErrArray() As Variant
   
    SheetCount = -1
    For Each ws In wb.Worksheets
    On Error Resume Next
    Errors = ws.UsedRange.Cells.SpecialCells(xlCellTypeFormulas, xlErrors).Count
    On Error GoTo 0
    If Errors > 0 Then
    SheetCount = SheetCount + 1
    ReDim Preserve ErrArray(SheetCount, 1)
        ErrArray(SheetCount, 0) = ws.Name
        ErrArray(SheetCount, 1) = Errors
    End If
   
    Errors = 0
    Next ws
   
    If IsArray(ErrArray) Then
    Sheets.Add After:=Sheets(Sheets.Count)
    Set ws = ActiveSheet
    ws.Name = "Errors"
   
    With Worksheets("Errors")
      .Cells(1, 1).Value = "Sheet Name"
      .Cells(1, 2).Value = "Error count"
      For i = LBound(ErrArray) To UBound(ErrArray)
        .Cells(i + 2, 1) = ErrArray(i, 0)
        .Cells(i + 2, 2) = ErrArray(i, 1)
      Next i
    End With
    End If
    'Haven't tested after this point.
    wb.Close SaveChanges:=True
    DoEvents
    myFile = Dir
  Loop
  MsgBox "Task Complete!"
ResetSettings:
  Application.EnableEvents = True
  Application.Calculation = xlCalculationAutomatic
  Application.ScreenUpdating = True
End Sub
 
Upvote 0
Maybe your "ErrArray" should include "myFile" (workbook's file name). ^^
It would be a nice modification but unnecessary at this point since each error report is inserted into every workbook. You should open every workbook and check "Errors" page. Consolidating all with wb name in a dedicated sheet is a good area but I have to rework on the code which is something I don't want :)
 
Last edited by a moderator:
Upvote 0
Because you have declared ErrArray as
VBA Code:
Dim ErrArray() As Variant
this line will always return true
VBA Code:
If IsArray(ErrArray) Then
 
Upvote 0
Frankly, I knocked off the code from somewhere else and didn't pay enough attention. Just took a look for small changes. I think the author had tried to state If UBound(ErrArray)>0 Then
 
Upvote 0
This code will loop through all the files within a folder. It will check for errors in each sheet. It will insert an "Errors" page to the end of each workbook. "Errors" sheet will include sheets names containing errors and number of errors.
I have tested the report part. It is working. But I didn't check the file looping part. You may need to fiddle around with the code. At least this may be a good start point for you:
VBA Code:
Sub CountErrors()
  Dim wb As Workbook
  Dim myPath As String
  Dim myFile As String
  Dim myExtension As String
  Dim FldrPicker As FileDialog

  Application.ScreenUpdating = False
  Application.EnableEvents = False
  Application.Calculation = xlCalculationManual

  Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)

    With FldrPicker
      .Title = "Select A Target Folder"
      .AllowMultiSelect = False
        If .Show <> -1 Then GoTo NextCode
        myPath = .SelectedItems(1) & "\"
    End With

NextCode:
  myPath = myPath
  If myPath = "" Then GoTo ResetSettings
  myExtension = "*.xls*"
  myFile = Dir(myPath & myExtension)
  Do While myFile <> ""
  'Code is working hereinafter. Haven't tested before this point.
    Set wb = Workbooks.Open(Filename:=myPath & myFile)

    Dim ws As Worksheet
    Dim Errors As Long
    Dim SheetCount As Integer
    Dim i As Long
    Dim ErrArray() As Variant
  
    SheetCount = -1
    For Each ws In wb.Worksheets
    On Error Resume Next
    Errors = ws.UsedRange.Cells.SpecialCells(xlCellTypeFormulas, xlErrors).Count
    On Error GoTo 0
    If Errors > 0 Then
    SheetCount = SheetCount + 1
    ReDim Preserve ErrArray(SheetCount, 1)
        ErrArray(SheetCount, 0) = ws.Name
        ErrArray(SheetCount, 1) = Errors
    End If
  
    Errors = 0
    Next ws
  
    If IsArray(ErrArray) Then
    Sheets.Add After:=Sheets(Sheets.Count)
    Set ws = ActiveSheet
    ws.Name = "Errors"
  
    With Worksheets("Errors")
      .Cells(1, 1).Value = "Sheet Name"
      .Cells(1, 2).Value = "Error count"
      For i = LBound(ErrArray) To UBound(ErrArray)
        .Cells(i + 2, 1) = ErrArray(i, 0)
        .Cells(i + 2, 2) = ErrArray(i, 1)
      Next i
    End With
    End If
    'Haven't tested after this point.
    wb.Close SaveChanges:=True
    DoEvents
    myFile = Dir
  Loop
  MsgBox "Task Complete!"
ResetSettings:
  Application.EnableEvents = True
  Application.Calculation = xlCalculationAutomatic
  Application.ScreenUpdating = True
End Sub
No sir i'm not looking for this. Thank you for your help.
 
Upvote 0
This code will loop through all the files within a folder. It will check for errors in each sheet. It will insert an "Errors" page to the end of each workbook. "Errors" sheet will include sheets names containing errors and number of errors.
I have tested the report part. It is working. But I didn't check the file looping part. You may need to fiddle around with the code. At least this may be a good start point for you:
VBA Code:
Sub CountErrors()
  Dim wb As Workbook
  Dim myPath As String
  Dim myFile As String
  Dim myExtension As String
  Dim FldrPicker As FileDialog

  Application.ScreenUpdating = False
  Application.EnableEvents = False
  Application.Calculation = xlCalculationManual

  Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)

    With FldrPicker
      .Title = "Select A Target Folder"
      .AllowMultiSelect = False
        If .Show <> -1 Then GoTo NextCode
        myPath = .SelectedItems(1) & "\"
    End With

NextCode:
  myPath = myPath
  If myPath = "" Then GoTo ResetSettings
  myExtension = "*.xls*"
  myFile = Dir(myPath & myExtension)
  Do While myFile <> ""
  'Code is working hereinafter. Haven't tested before this point.
    Set wb = Workbooks.Open(Filename:=myPath & myFile)

    Dim ws As Worksheet
    Dim Errors As Long
    Dim SheetCount As Integer
    Dim i As Long
    Dim ErrArray() As Variant
 
    SheetCount = -1
    For Each ws In wb.Worksheets
    On Error Resume Next
    Errors = ws.UsedRange.Cells.SpecialCells(xlCellTypeFormulas, xlErrors).Count
    On Error GoTo 0
    If Errors > 0 Then
    SheetCount = SheetCount + 1
    ReDim Preserve ErrArray(SheetCount, 1)
        ErrArray(SheetCount, 0) = ws.Name
        ErrArray(SheetCount, 1) = Errors
    End If
 
    Errors = 0
    Next ws
 
    If IsArray(ErrArray) Then
    Sheets.Add After:=Sheets(Sheets.Count)
    Set ws = ActiveSheet
    ws.Name = "Errors"
 
    With Worksheets("Errors")
      .Cells(1, 1).Value = "Sheet Name"
      .Cells(1, 2).Value = "Error count"
      For i = LBound(ErrArray) To UBound(ErrArray)
        .Cells(i + 2, 1) = ErrArray(i, 0)
        .Cells(i + 2, 2) = ErrArray(i, 1)
      Next i
    End With
    End If
    'Haven't tested after this point.
    wb.Close SaveChanges:=True
    DoEvents
    myFile = Dir
  Loop
  MsgBox "Task Complete!"
ResetSettings:
  Application.EnableEvents = True
  Application.Calculation = xlCalculationAutomatic
  Application.ScreenUpdating = True
End Sub

What are you looking for? What is not fitting to you?
Sir, its running across all workbook and creating error sheet, which is not error also its difficult to differentiate them too.
 
Upvote 0
OK, I've tested the code below. It will consolidate all information into your active sheet.
VBA Code:
Sub CountErrors()
  Dim wb As Workbook
  Dim myPath As String
  Dim myFile As String
  Dim myExtension As String
  Dim FldrPicker As FileDialog
  Dim r As Long
 
  r = 2
  Cells(1, 1).Value = "Sheet Name"
  Cells(1, 2).Value = "Error count"
  Application.ScreenUpdating = False
  Application.EnableEvents = False
  Application.Calculation = xlCalculationManual

  Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)

    With FldrPicker
      .Title = "Select A Target Folder"
      .AllowMultiSelect = False
        If .Show <> -1 Then GoTo NextCode
        myPath = .SelectedItems(1) & "\"
    End With

NextCode:
  myPath = myPath
  If myPath = "" Then GoTo ResetSettings
  myExtension = "*.xls*"
  myFile = Dir(myPath & myExtension)
  Do While myFile <> ""
    Set wb = Workbooks.Open(Filename:=myPath & myFile)
  
    Dim ws As Worksheet
    Dim Errors As Long
 
    For Each ws In wb.Worksheets
    On Error Resume Next
    Errors = ws.UsedRange.Cells.SpecialCells(xlCellTypeFormulas, xlErrors).Count
    On Error GoTo 0
    If Errors > 0 Then
        Cells(r, 1).Value = wb.FullName & " - " & ws.Name
        Cells(r, 2).Value = Errors
        r = r + 1
    End If
    Errors = 0
    Next ws

    wb.Close SaveChanges:=True
    DoEvents
    myFile = Dir
  Loop
  MsgBox "Task Complete!"
ResetSettings:
  Application.EnableEvents = True
  Application.Calculation = xlCalculationAutomatic
  Application.ScreenUpdating = True
End Sub
Yes, the code finds errors. If it says there is one, search for it harder.
 
Upvote 0

Forum statistics

Threads
1,223,886
Messages
6,175,191
Members
452,616
Latest member
intern444

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