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