Sub find_error()
Dim oFSO As Object
Dim oFolder As Object
Dim oFile As Object
Dim FldrPicker As FileDialog
Dim myFolder As String
Dim File_Open As Workbook
'Have User Select Folder to Save to with Dialog Box
Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)
With FldrPicker
.Title = "Select A Target Folder"
.AllowMultiSelect = False
If .Show <> -1 Then Exit Sub 'Check if user clicked cancel button
myFolder = .SelectedItems(1) & "\"
End With
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oFolder = oFSO.GetFolder(myFolder)
Application.ScreenUpdating = False
a = 7
For Each oFile In oFolder.Files
If InStr(1, oFile.Name, "xlsx") And Left(oFile.Name, 1) = "L" Then
Set File_Open = Workbooks.Open(oFile.Path)
For n = 1 To File_Open.Sheets.Count
If Not File_Open.Sheets(n).Name = "IPM-BSM-SA" Then
'File_Open.Sheets(n).Select
If InStr(1, File_Open.Sheets(n).Cells(1, 1), "Logging Data Inspection") Then
check = True
col = 1
While check
If InStr(1, File_Open.Sheets(n).Cells(3, col), "D3268") Or InStr(1, File_Open.Sheets(n).Cells(2, col), "D3268") Then
check = False
Else
col = col + 1
End If
Wend
i = 1
check = True
While check
If File_Open.Sheets(n).Cells(i, 1) = 1 Then
check = False
Else
i = i + 1
End If
Wend
While File_Open.Sheets(n).Cells(i, 2) <> ""
If InStr(1, UCase(File_Open.Sheets(n).Cells(i, col)), UCase("Angle_Error")) Then
File_Open.Sheets(n).Rows(i).Copy Destination:=Sheet1.Rows(a)
Sheet1.Cells(a, 51) = File_Open.Sheets(n).Name
a = a + 1
End If
i = i + 1
Wend
End If
End If
Next n
File_Open.Close SaveChanges:=False
End If
Next oFile
Application.ScreenUpdating = True
End Sub
