Hi Garry,

Please find the below code:

Sub getfile()
Dim f As String
Dim f1, f2, FN2, path As String
Dim wbk2 As Workbook, NewBook As Workbook
Dim xRow As Integer
path = "P:\test2\"
path1 = "P:\test2\Report\"
'f = Dir(path & "*.xls", vbDirectory)
'f3 = Replace(f, ".xls", "_Prod.xls")
Set NewBook = Workbooks.Add
With NewBook
.Title = "Report"
.Subject = "comparision"
.SaveAs Filename:=path1 & "Report-" & Format(Now, "ddmmyyyyhhmm") & ".xlsx"
End With
FN2 = NewBook.Name
Set wbk2 = Application.Workbooks.Open(path1 & FN2)

wbk2.Sheets(1).Range("A1").Value = "Report"
wbk2.Sheets(1).Range("B1").Value = "Sub Report"
wbk2.Sheets(1).Range("C1").Value = "Status"
wbk2.Sheets(1).Range("D1").Value = "Result"
wbk2.Sheets(1).Range("A1:D1").Interior.ColorIndex = 15
wbk2.Sheets(1).Range("A1:D1").Font.Bold = True
wbk2.Close SaveChanges:=True
Set objFso = CreateObject("Scripting.FileSystemObject")
Set objFld = objFso.GetFolder(path)
For Each objFile In objFld.Files
f1 = objFile.Name
f3 = Replace(f1, ".xls", "")
If Not InStr(f1, "_Prod") 0 Then
f2 = Replace(f1, ".xls", "_Prod.xls")
Set mySource = CreateObject("Scripting.FileSystemObject")
Set myFile = objFso.GetFolder(path)
For Each File In myFile.Files
If File < " " Then
If File.Name = f2 Then
Set wbk2 = Application.Workbooks.Open(path1 & FN2)
compare f1, f2, path, wbk2, FN2
Exit For
End If

Else
End If
Next File

Set wbk2 = Application.Workbooks.Open(path1 & FN2)
Set ws = wbk2.Sheets(1)
xRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row + 1
ws.Cells(xRow, 1).Value = f3
ws.Cells(xRow, 2).Value = " "
ws.Cells(xRow, 3).Value = "Fail"
ws.Cells(xRow, 4).Value = "No Prod File Found"
wbk2.Close SaveChanges:=True
End If
Next objFile
End Sub


This code checks for the files and returns if the prod file is not found and writes to a report.but there seems to be a problem with the looping.

Please see the below report that is generated: