Open Most Recent File Loop

[rmiles403]

I have a master workbook that needs to reach out to the most recent workbook in multiple different sub directories, as listed out in column C on Sheet 8 in the master, and copy the "Comprehensive" worksheet onto a new worksheet within the master work book. So far I have gotten the below code to properly create a worksheet for each sub directory in the master workbook, but I am having a problem having the code switch to any file beyond the most recent file in the first sub directory, so I end up with the same data on each of the new worksheets. The line of code that doesn't seem to be looping properly is "MyPath = rCell.Offset(0, 2).Text", but I may be way off base with all of this code in the first place. Any help you can provide would be GREATLY appreciated!




'Force the explicit delcaration of variables
Option Explicit

Sub OpenLatestFile()

'Declare the variables
Dim MyPath As String
Dim MyFile As String
Dim LatestFile As String
Dim LatestDate As Date
Dim LMD As Date
Dim Cnt As Long
Dim wbk As Workbook
Dim rRange As Range, rCell As Range
Dim wSheet As Worksheet
Dim wSheetStart As Worksheet
Dim strText As String

Sheet8.Select
Set wSheetStart = ActiveSheet
wSheetStart.AutoFilterMode = False
'Set a range variable to the correct item column
Set rRange = Range("A3", Range("A65536").End(xlUp))

On Error Resume Next
With wSheetStart
For Each rCell In rRange
strText = rCell
.Range("A2").AutoFilter 1, strText
Worksheets(strText).Delete

'Specify the path to the folder (change the path accordingly)
MyPath = rCell.Offset (0, 2).Text

'Make sure that the path ends in a backslash
If Right(MyPath, 1) <> "\" Then MyPath = MyPath & "\"

'Get the first Excel file from the folder
MyFile = Dir(MyPath & "*.xls", vbNormal)

'Loop through each Excel file in the folder
Do While Len(MyFile) > 0

'Assign the date/time of the current file to a variable
LMD = FileDateTime(MyPath & MyFile)

'If the date/time of the current file is greater than the latest
'recorded date, assign its filename and date/time to variables
If LMD > LatestDate Then
LatestFile = MyFile
LatestDate = LMD
Cnt = Cnt + 1
End If

'Get the next Excel file from the folder
MyFile = Dir

Loop

'Open the latest file
If Cnt > 0 Then

Application.EnableEvents = False
Workbooks.Open MyPath & LatestFile
Sheets("Comprehensive").Activate
ActiveSheet.Copy After:=ThisWorkbook.Sheets(8)
ActiveSheet.Name = strText
ActiveSheet.Tab.ColorIndex = 56
Application.DisplayAlerts = False
Workbooks(LatestFile).Close
Application.DisplayAlerts = False

Else
MsgBox "No files were found in this folder...", vbExclamation
End If
Next rCell
End With

With wSheetStart
.AutoFilterMode = False
.Activate
End With

On Error Resume Next
Application.DisplayAlerts = False
Worksheets("(Archived Entity QBR's)").Delete

On Error GoTo 0
Application.DisplayAlerts = True

End Sub

 

[rmiles403]

Any help that anyone can provide would be greatly appreciated. Thanks!