Open 2 Matching Files in Folder & Loop

chasoe

Board Regular
Joined
Jan 29, 2006
Messages
73
Dear Experts,

I've problems modifying below codes as they codes cannot finish to the end :

1. I've in folder many project files for current month and last month
2. Each file name has a standard format like 02015-201909-Flex*.xlsm (this month), and 02015-201908-Flex*.xlsm (last month), while * refers to any further characters that may be added for some particular files.
3. I wish the codes to open each pair of project files (this month then last month), and execute another macro to copy from 201908 file to 201909 file
4. However the codes stop in the middle

Code:
Sub OpenFlexO_and_FlexN()

'Open each project's Flex file (This Month), and then corresponding project's Flex file (Last Month), and perform copying from Flex (Last Month) to Flex (This Month)
'
'Ctrl+ b
'
Application.AskToUpdateLinks = False
Application.DisplayAlerts = False

Dim MyFlexFiles As String
Dim MyFlexOldFiles As String
Dim CurrentFolder As String
Dim FileName As String
Dim myPath As String
Dim UniqueName As Boolean

CMth = Range("O6")
LMth = Range("Q6")


UniqueName = False

'Store Information About Excel File

 MyFlexFiles = Dir(ActiveWorkbook.Path & "\" & "?????-" & CMth & "-Flex*.xlsm")

 MyFlexOldFiles = Dir(ActiveWorkbook.Path & "\" & "?????-" & LMth & "-Flex*.xlsm")

 
 Do While MyFlexFiles <> "" Or MyFlexOldFiles <> ""
  
  myPath = ActiveWorkbook.FullName
  CurrentFolder = ActiveWorkbook.Path & "\"
  FileName = Mid(myPath, InStrRev(myPath, "\") + 1, InStrRev(myPath, ".") - InStrRev(myPath, "\") - 1)
  ProjectCode = Mid(FileName, 1, 5)
  YearMth = Mid(FileName, 7, 6)
  
  'Open current month Flex file first
  Workbooks.Open ActiveWorkbook.Path & "\" & MyFlexFiles
  'Then Open last month Flex file
  Workbooks.Open ActiveWorkbook.Path & "\" & MyFlexOldFiles
    
  Call Copy_Lmth
    
  On Error GoTo 0
  
   MyFlexFiles = Dir
   MyFlexOldFiles = Dir
   
   Loop
    
Application.AskToUpdateLinks = True
Application.DisplayAlerts = True


MsgBox "Done : Copy This Mth to Last Mth in Transaction Worksheet"

Exit Sub


End Sub

Would like if anyone could help.

Many thanks.
 

Excel Facts

How to find 2nd largest value in a column?
MAX finds the largest value. =LARGE(A:A,2) will find the second largest. =SMALL(A:A,3) will find the third smallest
You can't have 2 Dir calls in the same loop because the 2nd Dir call loses the context of the 1st Dir call. The solution is to have a more general wildcard filespec for the Dir loop and put the specific matching files in a dynamic array (ReDim Preserve).

2. Each file name has a standard format like 02015-201909-Flex*.xlsm (this month), and 02015-201908-Flex*.xlsm (last month), while * refers to any further characters that may be added for some particular files.
If you have multiple files matching 02015-201909-Flex*.xlsm how would the code know which 02015-201909-Flex file to open? Similarly, if you have multiple files matching 02015-201908-Flex*.xlsm how would the code know which 02015-201908-Flex file to open? Are you saying that the "*" part of each pair of files must match? For example, are the files 02015-201909-FlexAAA.xlsm and 02015-201908-FlexAAA.xlsm matching pairs because the "AAA" parts match?
 
Upvote 0
Oh, sorry to make you confused :

1. The first 5 digits refer to project code
2. In the folder, there are only 2 matching pairs of same project code
3. I need to open 201909 (sep19) first, then 201908 (aug19), and run another macro to copy from aug19 to sep19 file
eg
02015-201909-Flex (revision2).xlsm
02015-201908-Flex.xlsm

02016-201909-Flex (r1).xlsm
02016-201908-Flex (final).xlsm

02018-201909-Flex.xlsm
02018-201908-Flex.xlsm

02033-201909-Flex (rev4).xlsm
02033-201908-Flex.xlsm

…….. so on
 
Last edited:
Upvote 0
Try this macro. Please note the Option Compare Text statement above the procedure - this makes the Like operator (and string comparisons with Left, Right, etc.) case-insensitive. Also, I've commented out the 2 lines which close each pair of matching workbooks because it's not clear if you want to close them or not.

Code:
Option Explicit
Option Compare Text

Public Sub OpenFlexO_and_FlexN()

    Dim FlexFile As String
    Dim FlexFiles() As String, numFlexFiles As Long, i As Long, j As Long
    Dim currentMonthFlexFile As String, lastMonthFlexFile As String
    Dim CMth As String, LMth As String
    Dim searchPath As String
    
    searchPath = ActiveWorkbook.Path & "\"
    
    CMth = Range("O6").Value
    LMth = Range("Q6").Value
    
    'Put Current month and Last month files in FlexFiles array
    
    numFlexFiles = 0
    FlexFile = Dir(searchPath & "?????-??????-Flex*.xlsm")
    Do While FlexFile <> vbNullString
        If FlexFile Like "?????-" & CMth & "-Flex*.xlsm" Or FlexFile Like "?????-" & LMth & "-Flex*.xlsm" Then
            ReDim Preserve FlexFiles(numFlexFiles)
            FlexFiles(numFlexFiles) = FlexFile
            numFlexFiles = numFlexFiles + 1
        End If
        FlexFile = Dir()
    Loop
        
    If numFlexFiles > 0 Then
    
        Application.AskToUpdateLinks = False
        Application.DisplayAlerts = False
    
        For i = 0 To UBound(FlexFiles)
        
            If FlexFiles(i) Like "?????-" & CMth & "-Flex*.xlsm" Then
            
                'This file matches the Current month
                
                currentMonthFlexFile = FlexFiles(i)
                
                'Find file with same project code for Last month
                
                lastMonthFlexFile = ""
                j = 0
                While j <= UBound(FlexFiles) And lastMonthFlexFile = ""
                    If FlexFiles(j) Like "?????-" & LMth & "-Flex*.xlsm" And Left(FlexFiles(j), 5) = Left(currentMonthFlexFile, 5) Then
                        lastMonthFlexFile = FlexFiles(j)
                    End If
                    j = j + 1
                Wend
                
                If lastMonthFlexFile <> "" Then
                
                    Workbooks.Open searchPath & currentMonthFlexFile
                    Workbooks.Open searchPath & lastMonthFlexFile
            
                    Copy_Lmth
                    
                    'Close the workbooks?
                    
                    'Workbooks(currentMonthFlexFile).Close
                    'Workbooks(lastMonthFlexFile).Close
                
                End If
            
            End If
            
        Next
        
        Application.AskToUpdateLinks = True
        Application.DisplayAlerts = True
        
        MsgBox "Done: Copy This Mth to Last Mth in Transaction Worksheet"
        
    End If

End Sub
 
Upvote 0
Tested your codes, and they work perfect, although I still have yet to learn using Like and Ubound etc when I have time.

In any case, thank you so much, as this macro can help save me lots of time each month handling massive volume of data.

Thanks indeed.
 
Upvote 0

Forum statistics

Threads
1,213,490
Messages
6,113,956
Members
448,535
Latest member
alrossman

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