Nested macros not looping correctly.

[CreativeUsername]

Hi,

I have a super macro that is giving fits and I'm not seeing why. It is made of macros that call other macros (all of which work correctly on their own). The SuperMacro needs to run from one workbook that opens other workbooks and activate their macros. SuperMacro and one of its nested macros are both "Do while - Loop" type. I get the error on the Super at the last line. It performs its own action and one other workbook that it activates but then it gets stuck.

As an over view SuperMacro runs from "Master.XLSM". It performs "Call End of Day Transfer" for its data that prepares XLSX files in the same folder to receive data (adds the correct tab if it doesn't exist). Pushes the Data and closes those XLSX files.

Then It should cycle through all XLSM files in the same folder and activate their "End of day Transfer" which has a nested "Call Archive" macro but not the Tab Preparation Macro. It should skip trying to open itself because it is already open. The elements all seem to be working fine till I combine them into SuperMacro then it gets stuck at "MyFiles = Dir" after its own update and one other XLSM open and run EOD Trans.

Sub SuperMacroEOD_Trans()
    Dim MyFiles As String
        Call EndofDayTransfer 'Do this Workbook Transfer first then:
'Step 2: Specify a target folder/directory.
    MyFiles = Dir("C:\Users\ME\Desktop\QA VBA Project\*.xlsm")
    
    'Dont try to open this workbook and do anything.
    Do While MyFiles <> "" And MyFiles <> "C:\Users\ME\Desktop\QA VBA Project\Master.xlsm"
'Step 3: Open Workbooks one by one
    Workbooks.Open "C:\Users\Me\Desktop\QA VBA Project\" & MyFiles
    Call EndofDayTransfer 'Call same macro you ran in the other workbooks (they contain it)
    ActiveWorkbook.Close SaveChanges:=True
'Step 4: Next File in the folder/Directory
      Loop
    MyFiles = Dir  <---- !!!!!!Stops there with Error!!!!!
    
    
End Sub

End of Day Trans:

[Sub EndofDayTransfer()
Call FileLoopforTabs '<------exists only in the version housed in "Master".  
Call ArchiveCopy
Call UpdatebyLoop
End SubCODE]

File FileLoopforTabs has the same structure as Super Macro

[CODE][
Sub FileLoopforTabs()
Dim MyFiles As String
MyFiles = Dir("C:\Users\Me\Desktop\QA VBA Project\*.xlsx")
Do While MyFiles <> ""
Workbooks.Open "C:\Users\Me\Desktop\QA VBA Project\" & MyFiles
Call TabsPrep '<-------------------------------See how it works
ActiveWorkbook.Close SaveChanges:=True
MyFiles = Dir
Loop
End Sub
/CODE]

Tabs Preparation code:
[CODE]
Sub TabsPrep() ' Date Tab Creation
Dim TabName As String
 
TabName = Format(Date, "mmm yy") 'Change the format as per your requirement
On Error GoTo AddNew
 Sheets(TabName).Activate
 Exit Sub
AddNew:
 Sheets.Add , Worksheets(Worksheets.Count)
 ActiveSheet.Name = TabName
 
 ActiveSheet.Previous.Range("A1:AK5").Copy Destination:=Range("A1")
 ActiveSheet.Previous.Range("AL1:AN50").Copy Destination:=Range("AL1")
 
 
End Sub

Tabs prep is only a step in the Master version of End of Day Trans.

The Archive is created here:

Sub ArchiveCopy()
 
    Dim LastRow As Long
    Dim ws As Worksheet
    Dim destRng As Range
    
       
    Application.ScreenUpdating = False
    
'Select source location and range
For Each ws In ActiveWorkbook.Worksheets

    If ws.Name <> "Skip Me" And ws.Name <> "Archive" Then
        ws.Activate
        Set destRng = Sheets("Archive").Cells(Rows.Count, "C").End(xlUp).Offset(2, 0)
            destRng.Offset(, -2) = Date
            destRng.Offset(, -1) = ActiveSheet.Name
       
'Copy selected range to last row
    
             LastRow = Range("A" & Rows.Count).End(xlUp).Row
            Range("A3:AJ" & LastRow).Copy Destination:=destRng
    
            'Application.ScreenUpdating = True
    
        End If
    Next ws
      
End Sub

The actual Data Transfer happens by a For Loop here:

Sub UpdatebyLoop()
                    'Define variables
Application.ScreenUpdating = False
Dim SourceWB As Workbook, destinationWB As Workbook
'Dim ws As Worksheet

                     'Data Transfer Section
Set SourceWB = ThisWorkbook
On Error GoTo errHandler
For Each ws In SourceWB.Worksheets
    If ws.Name <> "Skip Me" And ws.Name <> "Archive" Then
        Set destinationWB = Workbooks.Open(SourceWB.Path & "\" & ws.Name & ".xlsx")
        ws.Range("A3:AJ30").Copy Destination:=destinationWB.Sheets(Sheets.Count). _
            Cells(destinationWB.Sheets(Sheets.Count).Cells(Rows.Count, 2).End(xlUp).Row + 1, 2)
               destinationWB.Close SaveChanges:=True
                                                         
    End If
                    'Repeat on next worksheet
Next ws
With Application
    .CutCopyMode = False
    .ScreenUpdating = True
End With
Exit Sub
errHandler:
    MsgBox "Error " & Err.Number & ": " & Err.Description & vbCrLf & vbCrLf & _
    "Sorry, it seems the worksheet name - " & ws.Name & " - does not match a workbook name."
    Resume Next
End Sub

Again all the elements work from any given XLSM file on the associated XLXS files. The part that opens the other XLSM files gets part way through and then gets stuck. I'm wondering if its reading a double loop that is open someplace? I'm guessing between file loop for tabs and Super?

All XLSM workbooks are saved in enable/trust macros format from the trust center.

Any help is appreciated. I'm not thinking that it needs much.

 

[Ruddles]

Haven't you got these the wrong way round?

      Loop
    MyFiles = Dir  <---- !!!!!!Stops there with Error!!!!!

Get the next file name before you loop, no?