Open 2 Matching Files in Folder & Loop

[chasoe]

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

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.

 

[John_w]

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?

 

[chasoe]

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

 

[John_w]

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.

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

 

[chasoe]

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.