Could someone tell me if it is possible for a user to input two seperate dates into input boxes and then search a folder for files with (ideally) create dates that fall between the input dates?
I can do a search through files in a folder fine but the number of files is increasing every day and the time to run a search through all of them is getting longer. I'm hopeing that if the user can select a date range then this will cut down the time to run.
If that isn't possible at all is it possible to set a macro to search through files in a folder STARTING with the most recently created and then working back from there?
Sub UKSearch()
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Search function to find specific consignment number from multiple intake sheets'
'Used by Traffic Office '
'Created by *********** 11/03/14 Password to unlock = ********* '
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim FSO As Object 'FileSystemObject
Set FSO = CreateObject("scripting.filesystemobject")
Dim Directory As String
Dim FileName As String
Dim varCellvalue As Long
Application.ScreenUpdating = False
MsgBox ("This may take a few minutes")
'value to be searched
varCellvalue = Range("D13").Value
'Change the directory below as needed
Directory = "\\*******\shared$\Common\Returns\*********\"
If Right(Directory, 1) <> "\" Then
Directory = Directory & "\"
End If
'Search for all files in the directory with an xls* file type.
FileName = Dir(Directory & "*.xls*")
''''''''''''''''''''''''
'Opens, searches through and closes each file
Do While FileName <> ""
OpenFile = Directory & FileName
Workbooks.Open (OpenFile)
Workbooks(FileName).Activate
'Count through all the rows looking for the required number
ActiveWorkbook.Sheets("UK Scan Sheet").Activate
LastRow = Range("B65536").End(xlUp).Row
intRowCount = LastRow
Range("B1").Select
For i = 1 To intRowCount
'If the required number is found then select it and stop the search
If ActiveCell.Value = varCellvalue Then
GoTo Finish
Else
End If
ActiveCell.Offset(1, 0).Select
Next i
Workbooks(FileName).Close
FileName = Dir
OpenFile = ""
Loop
''''''''''''''''''''''''''
Finish:
Application.ScreenUpdating = False
End Sub