I added some code that may help. Because each file is in a different
directory you must take all the file informationm and perform a sort. I
created an array to put all this inrformation so you can perform a sort.
After the sort I added a section which determines the latest file by marking
the file true

Note: getfilename extracts just the filename from the path.

Let me know if you have any questions. the code is a little complicated.


Sub SrchForFiles()

Dim i As Long, z As Long, Rw As Long
Dim sReport As Workbook, sDashboard As Workbook
Dim ws As Worksheet, pat As Workbook
Dim sRpt As Object, dPt As Object
Dim y As Variant
Dim fLdr As String, Fil As String, FPath As String, x As String, _
pname As String, NumFound As String
Dim FileDates As Variant

Set fs = CreateObject("Scripting.FileSystemObject")

Wks_delete ' Delete old worksheets
ClearContents

y = "Sts*.xls"
If y = False And Not TypeName(y) = "String" Then Exit Sub
Application.ScreenUpdating = False
fLdr = dirPath '.SelectedItems(1)
Set sDashboard = ThisWorkbook

With Application.FileSearch
.NewSearch
.LookIn = fLdr
.SearchSubFolders = True
.Filename = y
Set ws = ThisWorkbook.Worksheets("Dashboard")
On Error GoTo 1
2:
On Error GoTo 0
NumFound = .Execute(msoSortByLastModified, msoSortOrderAscending, _
True)
If NumFound 0 Then
NewestFile = .FoundFiles.Count 'NewestFile = FilesFound(1)
ReDim FileDates(NewestFile, 4)
'get array to sort
For i = 1 To NewestFiles
Myfile = fs.GetFile(.FoundFiles(i))
FileDates(i, 1) = Myfile.Date
FileDates(i, 2) = Myfile.getfilename(Myfile.Name)
FileDates(i, 3) = i 'keep index number to use after sort
FileDates(i, 4) = False 'boolean indicating if latest
Next i
'sort by date newest to oldest
For i = 1 To (NewestFiles - 1)
For j = (i + 1) To NewestFiles
If FileDates(j, 1) FileDates(i, 1) Then
temp = FileDates(i, 1)
FileDates(i, 1) = FileDates(j, 1)
FileDates(j, 1) = temp

temp = FileDates(i, 2)
FileDates(i, 2) = FileDates(j, 2)
FileDates(j, 2) = temp

temp = FileDates(i, 3)
FileDates(i, 3) = FileDates(j, 3)
FileDates(j, 3) = temp

temp = FileDates(i, 4)
FileDates(i, 4) = FileDates(j, 4)
FileDates(j, 4) = temp

End If
Next j
Next i

'sort by filename
For i = 1 To (NewestFiles - 1)
For j = (i + 1) To NewestFiles
If FileDates(j, 1) FileDates(i, 1) Then
temp = FileDates(i, 1)
FileDates(i, 1) = FileDates(j, 1)
FileDates(j, 1) = temp

temp = FileDates(i, 2)
FileDates(i, 2) = FileDates(j, 2)
FileDates(j, 2) = temp

temp = FileDates(i, 3)
FileDates(i, 3) = FileDates(j, 3)
FileDates(j, 3) = temp

temp = FileDates(i, 4)
FileDates(i, 4) = FileDates(j, 4)
FileDates(j, 4) = temp

End If
Next j
Next i

'determine latest file
'first entry is always the latest
FileDates(1, 4) = True
For i = 2 To NewestFiles
If FileDates(i, 2) < FileDates(i - 1, 2) Then
FileDates(i, 4) = True
End If
Next
'the latest files are the ones with True in index 4
'index 3 is the index number in foundfiles

For i = 1 To NewestFile
NewestFile = .FoundFiles(1)
'Fil = .FoundFiles(i)
Fil = NewestFile
'Get file path from file name
FPath = Left(Fil, Len(Fil) - Len(Split(Fil, _
"\")(UBound(Split(Fil, "\")))) - 1)

If Left$(Fil, 1) = Left$(fLdr, 1) Then
If CBool(Len(Dir(Fil))) Then
x = (Array(Dir(Fil))(0))
End If
Set sReport = Workbooks.Open(.FoundFiles(i), _
UpdateLinks:=0)

' DelFormula

sReport.Worksheets(1).Copy _
After:=sDashboard.Sheets(sDashboard.Sheets.Count)
ActiveSheet.Name = sReport.Name & "(" & i & ")"

If i = 1 Then
z = 7
Else
z = z + 1
End If
Worksheets("Dashboard").Range("A" & z).Value = _
Worksheets(ActiveSheet.Name).Range("staPrgNum").Va lue
Worksheets("Dashboard").Range("B" & z).Value = _
Worksheets(ActiveSheet.Name).Range("staPrgName").V alue
Worksheets("Dashboard").Range("C" & z).Value = _
Worksheets(ActiveSheet.Name).Range("staPrgMgr").Va lue
Worksheets("Dashboard").Range("D" & z).Value = _
Worksheets(ActiveSheet.Name).Range("staDelDate").V alue
Worksheets("Dashboard").Range("F" & z).Value = _
Worksheets(ActiveSheet.Name).Range("TotVariance"). Value
Worksheets("Dashboard").Range("G" & z).Value = _
Worksheets(ActiveSheet.Name).Range("CompPct").Valu e
Worksheets("Dashboard").Range("Q" & z).Value = _
Worksheets(ActiveSheet.Name).Range("CompPct").Valu e
sReport.Close SaveChanges = False
Worksheets(ActiveSheet.Name).Select
Worksheets(ActiveSheet.Name).Visible = False
Sheets("Dashboard").Select
ws.Hyperlinks.Add Range("a" & z), Address:="", _
SubAddress:="Dashboard!A" & z
End If
Next i
End If
End With

ActiveWindow.DisplayHeadings = False
Application.ScreenUpdating = True
Exit Sub
1: Application.DisplayAlerts = False
Worksheets("FileSearch Results").Delete
Application.DisplayAlerts = True
GoTo 2
End Sub

'+++++++++++++++++++++++++++++

Sub Wks_delete()
Dim i As Integer

Application.ScreenUpdating = False
Application.DisplayAlerts = False
For i = ActiveWorkbook.Worksheets.Count To 1 Step -1
If Worksheets(i).Name < "Dashboard" Then _
Worksheets(i).Delete
Next i
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
'++++++++++++++++++++++
Sub ClearContents()
Dim rng As Range
Set rng = Range("A7:D70")
rng.ClearContents
Set rng = Range("F7:Q70")
rng.ClearContents
End Sub


"Patrick Kirk" wrote:

I am attempting to utilize the .FileSearch operation to search for certain
file(s) within a pre-defined directory and all subdirectories. The below
scripts will copy all worksheets of the workbook found to a main workbook and
list the findings in a worksheet. The problem is if there are two files
beginning with the search cretiria, (ex: R00291 or R00294) it will display
all files.

How do I change the code to find only the latest (last created) file?

Output Once script is ran!+++++++++++++++++++++++++++++++++++
R00263 Asdf George Jeffer 1-Jan-01 0 43%
R00276 Sdfasdf George Jeffer 1-Jan-01 0 77%
R00291 Sdafas William Clinton 1-Jan-01 0 40%
R00294 S Nick Bush 1-Jan-01 0 64%
R00287 D Nick Bush 1-Jan-01 0 91%
R00294 S Nick Bush 1-Jan-01 0 64%
R00291 Sdafas William Clinton 1-Jan-01 0 40%
R00291 Sdafas William Clinton 1-Jan-01 450 40%
R00291 Sdafas William Clinton 1-Jan-01 450 40%

++++++++++++++++++++++++++++++++++



Sub SrchForFiles()

Dim i As Long, z As Long, Rw As Long
Dim sReport As Workbook, sDashboard As Workbook
Dim ws As Worksheet, pat As Workbook
Dim sRpt As Object, dPt As Object
Dim y As Variant
Dim fLdr As String, Fil As String, FPath As String, x As String, pname
As String, NumFound As String

Wks_delete ' Delete old worksheets
ClearContents

y = "Sts*.xls"
If y = False And Not TypeName(y) = "String" Then Exit Sub
Application.ScreenUpdating = False
fLdr = dirPath '.SelectedItems(1)
Set sDashboard = ThisWorkbook

With Application.FileSearch
.NewSearch
.LookIn = fLdr
.SearchSubFolders = True
.Filename = y
Set ws = ThisWorkbook.Worksheets("Dashboard")
On Error GoTo 1
2:
On Error GoTo 0
NumFound = .Execute(msoSortByLastModified, msoSortOrderAscending,
True)
If NumFound 0 Then
NewestFile = .FoundFiles.Count 'NewestFile = FilesFound(1)
For i = 1 To NewestFile
NewestFile = .FoundFiles(1)
'Fil = .FoundFiles(i)
Fil = NewestFile
'Get file path from file name
FPath = Left(Fil, Len(Fil) - Len(Split(Fil,
"\")(UBound(Split(Fil, "\")))) - 1)

If Left$(Fil, 1) = Left$(fLdr, 1) Then
If CBool(Len(Dir(Fil))) Then
x = (Array(Dir(Fil))(0))
End If
Set sReport = Workbooks.Open(.FoundFiles(i),
UpdateLinks:=0)

DelFormula

sReport.Worksheets(1).Copy
After:=sDashboard.Sheets(sDashboard.Sheets.Count)
ActiveSheet.Name = sReport.Name & "(" & i & ")"

If i = 1 Then
z = 7
Else
z = z + 1
End If
Worksheets("Dashboard").Range("A" & z).Value =
Worksheets(ActiveSheet.Name).Range("staPrgNum").Va lue
Worksheets("Dashboard").Range("B" & z).Value =
Worksheets(ActiveSheet.Name).Range("staPrgName").V alue
Worksheets("Dashboard").Range("C" & z).Value =
Worksheets(ActiveSheet.Name).Range("staPrgMgr").Va lue
Worksheets("Dashboard").Range("D" & z).Value =
Worksheets(ActiveSheet.Name).Range("staDelDate").V alue
Worksheets("Dashboard").Range("F" & z).Value =
Worksheets(ActiveSheet.Name).Range("TotVariance"). Value
Worksheets("Dashboard").Range("G" & z).Value =
Worksheets(ActiveSheet.Name).Range("CompPct").Valu e
Worksheets("Dashboard").Range("Q" & z).Value =
Worksheets(ActiveSheet.Name).Range("CompPct").Valu e
sReport.Close SaveChanges = False
Worksheets(ActiveSheet.Name).Select
Worksheets(ActiveSheet.Name).Visible = False
Sheets("Dashboard").Select
ws.Hyperlinks.Add Range("a" & z), Address:="",
SubAddress:="Dashboard!A" & z
End If
Next i
End If
End With

ActiveWindow.DisplayHeadings = False
Application.ScreenUpdating = True
Exit Sub
1: Application.DisplayAlerts = False
Worksheets("FileSearch Results").Delete
Application.DisplayAlerts = True
GoTo 2
End Sub

+++++++++++++++++++++++++++++

Sub Wks_delete()
Dim i As Integer

Application.ScreenUpdating = False
Application.DisplayAlerts = False
For i = ActiveWorkbook.Worksheets.Count To 1 Step -1
If Worksheets(i).Name < "Dashboard" Then _
Worksheets(i).Delete
Next i
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
++++++++++++++++++++++
Sub ClearContents()
Dim rng As Range
Set rng = Range("A7:D70")
rng.ClearContents
Set rng = Range("F7:Q70")
rng.ClearContents
End Sub


--
PK