CODEWITHSUNDEEP
vbaexcel
user
user

Reputation: 1035

Macro exiting early with no error

I am using the below code to copy in all the workbooks from a particular folder into one workbook. 9 out of 10 times the code works fine and all the data is copied but occasionally the macro appears to exit early without finishing as the msgbox never displays and I do not get any error message. The macro appears to have been exited as it allows me to run other macros. Can anyone advise me what might be causing this? It seems to happen if you start to do other things on your computer while the macro is running.

Sub GetSheets()

Application.ScreenUpdating = False

Dim response
 response = MsgBox("This will take some time to run. Are you sure you want to proceed?", vbYesNo)
 If response = vbNo Then
 Exit Sub
 End If


Application.Run ("GetxlsxFiles")
Application.Run ("GetxlsFiles")

DataCopied = 1

Sheets("Instructions").Select

MsgBox "Completed Successfully"
End Sub

Sub GetxlsxFiles()
Dim Sheet As Worksheet
Path = Sheets("Instructions").Range("FileName").Value
Filename = Dir(Path & "*.xlsx")

Do While Filename <> ""
Workbooks.Open Filename:=Path & Filename, ReadOnly:=True, Password:="Password"
For Each Sheet In ActiveWorkbook.Sheets
Sheet.Copy After:=Workbooks("RSModel.xlsm").Sheets("Current KPIs")
Next Sheet

Workbooks(Filename).Close saveChanges:=False
Filename = Dir()
Loop

End Sub

The getxlsfiles sub is the exact same as the above except for the file extension.

Upvotes: 0

Views: 604

Answers (1)

L42
L42

Reputation: 19737

I've re-written your code and just provide comments in there.
There's just too many to fit in the comment.

Here's the GetxlsxFiles Sub:
It's actually brief if you remove the comments which explains what I did.

Sub GetxlsxFiles()
    Dim wb As Workbook, wbTemp As Workbook
    Dim Path As String, Filename As String ', masterWB As String
    Dim Sheet As Worksheet
    '~~> Assuming the path is correct
    Path = Sheets("Instructions").Range("FileName").Value
    '~~> Path should contain e.g. "C:\TestFolder\"
    Filename = Dir(Path & "*.xlsx")
    '~~> Assuming you are consolidating all sheets 
    '~~> in the workbook that contain the macro
    Set wb = ThisWorkbook
    '~~> If not, use the commented line below
    '~~> Take note that you do not include the file extension
    'Set wb = Workbooks("RSModel")
    '~~> Or you can also open it like this
    'masterWB = "C:\Foldername\RSModel.xlsm"
    'Set wb = Workbooks.Open(Filename:=masterWB, ReadOnly:=True)
    Do While Filename <> ""
        Set wbTemp = Workbooks.Open(Filename:=Path & Filename, ReadOnly:=True, _
                        Password:="Password")
        For Each Sheet In wbTemp.Sheets
            '~~> this adds the sheet after the last sheet in the target WB
            '~~> If you specifically want to add it after a specific sheet, 
            '~~> use the commented line
            Sheet.Copy After:=wb.Sheets(wb.Sheets.Count)
            'Sheet.Copy After:=wb.Sheets("Current KPIs")
        Next
        wbTemp.Close False
        Filename = Dir
    Loop

End Sub

Here is the GetSheets Sub:

Sub GetSheets()
    Application.ScreenUpdating = False
    Dim response As Integer
    response = MsgBox("This will take some time to run." & vbNewLine & _
               "Are you sure you want to proceed?", vbYesNo)
    '~~> execute IF in one line
    If response = vbNo Then Exit Sub
    '~~> No need to use Application.Run. Call the subs directly
    GetxlsxFiles
    GetxlsFiles
    '~~> Not sure what's this for so I commented it
    'DataCopied = 1
    '~~> If you want below sheet to be selected then
    ThisWorkbook.Sheets("Instructions").Select
    MsgBox "Completed Successfully", vbInformation
End Sub

I think above should be close to what you want.
Hope this helps.

Upvotes: 1

Related Questions