Generalised vba code to open previous file than current file

ruturajs7rs

New Member
Joined
Jan 26, 2021
Messages
11
Office Version
  1. 365
Platform
  1. Windows
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."
 

Excel Facts

Why does 9 mean SUM in SUBTOTAL?
It is because Sum is the 9th alphabetically in Average, Count, CountA, Max, Min, Product, StDev.S, StDev.P, Sum, VAR.S, VAR.P.
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.

VBA Code:
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
 
Upvote 0
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.

VBA Code:
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.
 
Last edited:
Upvote 0
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.

VBA Code:
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?
 
Upvote 0
This revised macro should do it.
VBA Code:
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
 
Upvote 0
Solution

Forum statistics

Threads
1,224,827
Messages
6,181,200
Members
453,022
Latest member
RobertV1609

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top