Generalised vba code to open previous file than current file

[ruturajs7rs]

Dear all,
I am looking for a VBA code to open and copy data from a file that is uploaded recently than the current file in the folder to compare data. I have 4 folders - Test1,Test2,Test3, Test4. The files in the folders are in the format "Test1_YYYYMMDD" (in folder Test1 and YYYYMMDD is the date of creation of file) and similarly in other folders. Now for example I consider folder Test1 and perform macro in Today's file (i.e. Test1_20200203), then the macro should open and copy data from the file which is present before the file in which macro is run. The file can be yesterday's or one week before (whichever the macro finds first).
I can perform it in a single folder but I want to know how can I make it generalized so it works in the other 3 folders as well within a single macro.

Code I am using for single folder-
Public Sub openfile()
Dim dtTestDate As Date
Dim sStartWB As String

Const sPath As String = "C:\Test\"
Const dtEarliest = #1/1/2021#

dtTestDate = Date
sStartWB = ActiveWorkbook.name

While ActiveWorkbook.Name = sStartWB And dtTestDate >= dtEarliest
On Error Resume Next
Workbooks.Open sPath & "Test1_" & Format(dtTestDate, "YYYYMMDD" & ".xls"
dtTestDate = dtTestDate - 1
On Error GoTo 0
Wend

If ActiveWorkbook.Name = sStartWB Then MsgBox "Earlier file not found."

 

[John_w]

See if this macro does what you want. It assumes the macro workbook (e.g. Test1_20200203.xls) is in one of the Test1, Test2, Test3 or Test4 folders.

Public Sub Open_Previous_Workbook()

    Dim parentFolder As String
    Dim subFolder As Variant
    Dim datePart As String
    Dim currentWbDate As Date, currentWbDateFile As String
    Dim fileName As String
    Dim thisWbDate As Date, thisWbDateFile As Variant
    Dim dateFilesArray As Object
    Dim previousWbDateFile As String, previousWbFullName As String
    
    With ActiveWorkbook
        parentFolder = Left(.Path, InStrRev(.Path, "\"))
        datePart = Split(.Name, "_")(1)
        currentWbDate = DateSerial(Left(datePart, 4), Mid(datePart, 5, 2), Mid(datePart, 7, 2))
        'Save "YYYYMMDD|full name" string for current workbook
        currentWbDateFile = Format(currentWbDate, "YYYYMMDD") & "|" & .FullName
    End With
    
    Set dateFilesArray = CreateObject("System.Collections.ArrayList")
    
    'Create array of "YYYYMMDD|full name" strings for every Test*_*.xls file in the subfolders
    
    For Each subFolder In Array("Test1", "Test2", "Test3", "Test4")
        fileName = Dir(parentFolder & subFolder & "\Test*_*.xls")
        While fileName <> vbNullString
            datePart = Split(fileName, "_")(1)
            thisWbDate = DateSerial(Left(datePart, 4), Mid(datePart, 5, 2), Mid(datePart, 7, 2))
            dateFilesArray.Add Format(thisWbDate, "YYYYMMDD") & "|" & parentFolder & subFolder & "\" & fileName
            fileName = Dir
        Wend
    Next
    
    'Sort array in descending order
    
    dateFilesArray.Sort
    dateFilesArray.Reverse
    
    'Find first file whose YYYYMMDD date is earlier than current workbook's YYYYMMDD date
    
    previousWbDateFile = ""
    For Each thisWbDateFile In dateFilesArray
        If thisWbDateFile < currentWbDateFile Then
            previousWbDateFile = thisWbDateFile
            Exit For
        End If
    Next
    
    If previousWbDateFile <> "" Then
        previousWbFullName = Split(previousWbDateFile, "|")(1)
        MsgBox "Previous workbook " & previousWbFullName & " will be opened", vbInformation
        Workbooks.Open previousWbFullName
    Else
        MsgBox "There are no workbooks previous to " & ActiveWorkbook.Name, vbExclamation
    End If
    
End Sub

 

[ruturajs7rs]

See if this macro does what you want. It assumes the macro workbook (e.g. Test1_20200203.xls) is in one of the Test1, Test2, Test3 or Test4 folders.

Public Sub Open_Previous_Workbook()

    Dim parentFolder As String
    Dim subFolder As Variant
    Dim datePart As String
    Dim currentWbDate As Date, currentWbDateFile As String
    Dim fileName As String
    Dim thisWbDate As Date, thisWbDateFile As Variant
    Dim dateFilesArray As Object
    Dim previousWbDateFile As String, previousWbFullName As String
  
    With ActiveWorkbook
        parentFolder = Left(.Path, InStrRev(.Path, "\"))
        datePart = Split(.Name, "_")(1)
        currentWbDate = DateSerial(Left(datePart, 4), Mid(datePart, 5, 2), Mid(datePart, 7, 2))
        'Save "YYYYMMDD|full name" string for current workbook
        currentWbDateFile = Format(currentWbDate, "YYYYMMDD") & "|" & .FullName
    End With
  
    Set dateFilesArray = CreateObject("System.Collections.ArrayList")
  
    'Create array of "YYYYMMDD|full name" strings for every Test*_*.xls file in the subfolders
  
    For Each subFolder In Array("Test1", "Test2", "Test3", "Test4")
        fileName = Dir(parentFolder & subFolder & "\Test*_*.xls")
        While fileName <> vbNullString
            datePart = Split(fileName, "_")(1)
            thisWbDate = DateSerial(Left(datePart, 4), Mid(datePart, 5, 2), Mid(datePart, 7, 2))
            dateFilesArray.Add Format(thisWbDate, "YYYYMMDD") & "|" & parentFolder & subFolder & "\" & fileName
            fileName = Dir
        Wend
    Next
  
    'Sort array in descending order
  
    dateFilesArray.Sort
    dateFilesArray.Reverse
  
    'Find first file whose YYYYMMDD date is earlier than current workbook's YYYYMMDD date
  
    previousWbDateFile = ""
    For Each thisWbDateFile In dateFilesArray
        If thisWbDateFile < currentWbDateFile Then
            previousWbDateFile = thisWbDateFile
            Exit For
        End If
    Next
  
    If previousWbDateFile <> "" Then
        previousWbFullName = Split(previousWbDateFile, "|")(1)
        MsgBox "Previous workbook " & previousWbFullName & " will be opened", vbInformation
        Workbooks.Open previousWbFullName
    Else
        MsgBox "There are no workbooks previous to " & ActiveWorkbook.Name, vbExclamation
    End If
  
End Sub

Hi John, Thank you for the reply.

 

[ruturajs7rs]

See if this macro does what you want. It assumes the macro workbook (e.g. Test1_20200203.xls) is in one of the Test1, Test2, Test3 or Test4 folders.

Public Sub Open_Previous_Workbook()

    Dim parentFolder As String
    Dim subFolder As Variant
    Dim datePart As String
    Dim currentWbDate As Date, currentWbDateFile As String
    Dim fileName As String
    Dim thisWbDate As Date, thisWbDateFile As Variant
    Dim dateFilesArray As Object
    Dim previousWbDateFile As String, previousWbFullName As String
   
    With ActiveWorkbook
        parentFolder = Left(.Path, InStrRev(.Path, "\"))
        datePart = Split(.Name, "_")(1)
        currentWbDate = DateSerial(Left(datePart, 4), Mid(datePart, 5, 2), Mid(datePart, 7, 2))
        'Save "YYYYMMDD|full name" string for current workbook
        currentWbDateFile = Format(currentWbDate, "YYYYMMDD") & "|" & .FullName
    End With
   
    Set dateFilesArray = CreateObject("System.Collections.ArrayList")
   
    'Create array of "YYYYMMDD|full name" strings for every Test*_*.xls file in the subfolders
   
    For Each subFolder In Array("Test1", "Test2", "Test3", "Test4")
        fileName = Dir(parentFolder & subFolder & "\Test*_*.xls")
        While fileName <> vbNullString
            datePart = Split(fileName, "_")(1)
            thisWbDate = DateSerial(Left(datePart, 4), Mid(datePart, 5, 2), Mid(datePart, 7, 2))
            dateFilesArray.Add Format(thisWbDate, "YYYYMMDD") & "|" & parentFolder & subFolder & "\" & fileName
            fileName = Dir
        Wend
    Next
   
    'Sort array in descending order
   
    dateFilesArray.Sort
    dateFilesArray.Reverse
   
    'Find first file whose YYYYMMDD date is earlier than current workbook's YYYYMMDD date
   
    previousWbDateFile = ""
    For Each thisWbDateFile In dateFilesArray
        If thisWbDateFile < currentWbDateFile Then
            previousWbDateFile = thisWbDateFile
            Exit For
        End If
    Next
   
    If previousWbDateFile <> "" Then
        previousWbFullName = Split(previousWbDateFile, "|")(1)
        MsgBox "Previous workbook " & previousWbFullName & " will be opened", vbInformation
        Workbooks.Open previousWbFullName
    Else
        MsgBox "There are no workbooks previous to " & ActiveWorkbook.Name, vbExclamation
    End If
   
End Sub

Hi John,
If I have to run this code in folder Test3 (for example), then it will check the most recent file than the current file in all folders, but I do not require a file from another folder, rather a file from folder Test3 as I am running the code in Test3.
Can you please tell me a solution for that?

 

[John_w]

This revised macro should do it.

Public Sub Open_Previous_Workbook2()

    Dim parentFolder As String
    Dim datePart As String
    Dim currentWbDate As Date, currentWbDateFile As String
    Dim fileName As String
    Dim thisWbDate As Date, thisWbDateFile As Variant
    Dim dateFilesArray As Object
    Dim previousWbDateFile As String, previousWbFullName As String
    
    With ActiveWorkbook
        parentFolder = .Path
        datePart = Split(.Name, "_")(1)
        currentWbDate = DateSerial(Left(datePart, 4), Mid(datePart, 5, 2), Mid(datePart, 7, 2))
        'Save "YYYYMMDD|full name" string for current workbook
        currentWbDateFile = Format(currentWbDate, "YYYYMMDD") & "|" & .FullName
    End With
    
    Set dateFilesArray = CreateObject("System.Collections.ArrayList")
    
    'Create array of "YYYYMMDD|full name" strings for every Test*_*.xls file in the subfolders
    
    fileName = Dir(parentFolder & "\Test*_*.xls")
    While fileName <> vbNullString
        datePart = Split(fileName, "_")(1)
        thisWbDate = DateSerial(Left(datePart, 4), Mid(datePart, 5, 2), Mid(datePart, 7, 2))
        dateFilesArray.Add Format(thisWbDate, "YYYYMMDD") & "|" & parentFolder & "\" & fileName
        fileName = Dir
    Wend
    
    'Sort array in descending order
    
    dateFilesArray.Sort
    dateFilesArray.Reverse
    
    'Find first file whose YYYYMMDD date is earlier than current workbook's YYYYMMDD date
    
    previousWbDateFile = ""
    For Each thisWbDateFile In dateFilesArray
        datePart = Split(thisWbDateFile, "|")(0)
        thisWbDate = DateSerial(Left(datePart, 4), Mid(datePart, 5, 2), Mid(datePart, 7, 2))
        If thisWbDate < currentWbDate Then
            previousWbDateFile = thisWbDateFile
            Exit For
        End If
    Next
    
    If previousWbDateFile <> "" Then
        previousWbFullName = Split(previousWbDateFile, "|")(1)
        MsgBox "Previous workbook " & previousWbFullName & " will be opened", vbInformation
        Workbooks.Open previousWbFullName
    Else
        MsgBox "There are no workbooks previous to " & ActiveWorkbook.Name, vbExclamation
    End If
    
End Sub