'The while loop sometimes is infinite

Sub Copy_Worksheets_Columns_Rows_to_ALL_D2()
    'PURPOSE: To loop through all Excel files in a user specified folder and perform a set task on them
    'Task: Copy worksheets, columns and rows to ALL (D2)
    
    Dim sourceSheet1 As Worksheet
    Dim sourceSheet2 As Worksheet
    Dim sourceSheet3 As Worksheet
    Dim sourceColumn As Range, targetColumn As Range
    Dim sourceRow As Range, targetRow As Range
    Dim sht As Worksheet
    Dim fnd As Variant
    Dim rplc As Variant
    Dim folder As String, filename As String
    Dim destinationWorkbook As Workbook
    Dim myPath As String
    Dim ALL_File As String
    Dim ALL_Extension As String
    
    'Optimize Macro Speed
    Application.Calculation = xlCalculationManual
        
    myPath = ActiveWorkbook.Path
    If Right(myPath, 1) <> "\" Then myPath = myPath + "\"
            
    SampleFileExtension = "sample.xlsx"
        
    Set sourceWorkbook = Workbooks.Open(myPath & SampleFileExtension, Local:=True)
    
    'Worksheet in source workbook to be copied as a new sheet
    Set sourceSheet1 = sourceWorkbook.Worksheets(1)
    Set sourceSheet2 = sourceWorkbook.Worksheets(2)
    Set sourceSheet3 = sourceWorkbook.Worksheets(3)
    
    Set sourceColumn = sourceWorkbook.Worksheets(4).Range("T:AD")
    Set sourceRow = sourceWorkbook.Worksheets(4).Range("1026:1038")
    
    fnd = "[" & sourceWorkbook.Name & "]"
    rplc = ""
        
    'ALL Target File Extension (must include wildcard "*")
    ALL_Extension = "*.2.*.ALL.xlsx"
    'ALL Target Path with Ending Extention
    ALL_File = Dir(myPath & ALL_Extension)
    
    Do While ALL_File <> ""
        Set destinationWorkbook = Workbooks.Open(filename:=myPath & ALL_File, Local:=True)
       
       'Ensure Workbook has opened before moving on to next line of code
        DoEvents
        
        sourceSheet3.Copy before:=destinationWorkbook.Sheets(1)
        sourceSheet2.Copy before:=destinationWorkbook.Sheets(1)
        sourceSheet1.Copy before:=destinationWorkbook.Sheets(1)
        Set targetColumn = ActiveWorkbook.Worksheets(4).Range("T:AD")
        sourceColumn.Copy Destination:=targetColumn
        Set targetRow = ActiveWorkbook.Worksheets(4).Range("1026:1038")
        sourceRow.Copy Destination:=targetRow
                
       'Perform the Find/Replace All
        Sheets(4).Range("A1:AD1038").Replace what:=fnd, Replacement:=rplc, _
            LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _
            SearchFormat:=False, ReplaceFormat:=False
        
        destinationWorkbook.Close True
        Exit Do
        
       'Get next matching file
        ALL_File = Dir()
            
    Loop
        
    sourceWorkbook.Close False
    
    'Message Box when tasks are completed
      'MsgBox "Copy D2 worksheets, columns and rows to ALL (Task 5) Complete!"

End Sub


Solution 1:[1]

When you modify files in a loop that is based on Dir you may get into this situation. Dir is great when you don't modify the files in the folder you are iterating over, but if you do make modifications, it is risky.

A pragmatic solution is to first collect the files you want to process, and then loop over that collection:

Dim ALL_File As Variant  ' Make sure it is Variant now
Dim c As Collection
Set c = New Collection

' Other initialisations ...
' ...
' ...

ALL_File = Dir(myPath & ALL_Extension)

' Collect file names  
Do While ALL_File <> ""
    c.Add ALL_File
    ALL_File = Dir
Loop

' Iterate over the collection of file names
For Each ALL_File In c
    Set destinationWorkbook = Workbooks.Open(filename:=myPath & ALL_File, Local:=True)
       
    ' ... process the open workbook ...
    ' ...

    destinationWorkbook.Close True
Next

In summary:

  • Modify the declaration of ALL_File so it is a Variant, not a String
  • Add the declaration of c and its initialisation.
  • Add the new, smaller loop that uses Dir to populate the c collection.
  • Turn your existing loop from a Do While...Loop into a For Each...Next loop (as shown above)
  • Remove the last statement from that loop, which did the call to Dir

Sources

This article follows the attribution requirements of Stack Overflow and is licensed under CC BY-SA 3.0.

Source: Stack Overflow

Solution Source
Solution 1