Joel,

I think Im missing something here. Im still receiving the same output. I've
followed the array as much as I can with my limited knowledge of VBA but
couldn't find where the code actually determines the latest instance of a
file.

If Im not mistaken, it appears if the array object #4 is true, then the
contents of the array is written. I also made a modification to the code
referencing the Getfile and Getfilename methods. What are your thoughts?

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 NewestFile
myfile = fs.getfile(.FoundFiles(i))
Set jj = fs.getfile(.FoundFiles(i))
xxx = fs.Getfilename(.FoundFiles(i))
FileDates(i, 1) = jj.Datecreated
FileDates(i, 2) = xxx '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 (NewestFile - 1)
For j = (i + 1) To NewestFile
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 (NewestFile - 1)
For j = (i + 1) To NewestFile
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 NewestFile
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
If FileDates(i, 4) = True Then
Set sReport = Workbooks.Open(.FoundFiles(FileDates(i,
3)), UpdateLinks:=0)

' DelFormula

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

If FileDates(i, 3) = 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


--
PK


"Joel" wrote:

My original code was not complete. It was just to get you started. I made a
few more changes, see if this helps

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
If FileDates(i, 4) = True Then
Set sReport = Workbooks.Open(.FoundFiles(FileDates(i,
3)), _
UpdateLinks:=0)

' DelFormula

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

If FileDates(i, 3) = 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:

Joel,

No luck, I continue to experience the problem of showing all documents not
just the latest modified/updated.

Example:
R00276 Sdfasdf George Jeffers 1-Jan-01 0 77%
R00287 D Nick Bush 1-Jan-01 0 91%
R00291 Sdafas William Clinton 1-Jan-01 450 40%
R00294 S Nick Bush 1-Jan-01 0 64%
R00307 Ies Tactics Nick Bh 1-Jan-02 500 40%
R00291 Sdafas William Clinton 1-Jan-01 450 40%



My filesearch searches for "Sts*.xls". The document names a
StsRpt_R00291_26Jan08.xls & StsRpt_R00291_27Jan08.xls; both might be in the
same directory or different directories.

Is there a way to only show the last modified file of each instance found?
--
PK


"Joel" wrote:

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)