Multiple work book paste crashing at 3+ files

Question

The below code works fine when I ask it to add the information from the first two files with approximately 200 rows, however if i add a third it crashes Excel. I need this code to combine upward of 40 files each time it is run by the user.

I had originally written the file to use selects and found a post here saying that it could slow down or cause crash and rewrote it to this current iteration removing all selects from the program.

Public Sub ImportUpdates()
Dim ImportXL        As Workbook
Dim OpenFiles()     As Variant
Dim i               As Long
Dim r               As Long
Dim n               As Long
Dim Crntwrkbk       As String
Dim Crng            As Range
Dim Cloc            As Long



'Application.ScreenUpdating = False


Crntwrkbk = ThisWorkbook.Name


OpenFiles = Application.GetOpenFilename( _
Title:="Select File(s) To Import", _
MultiSelect:=True)

n = Application.CountA(OpenFiles)

For i = 1 To n
        Set ImportXL = Workbooks.Open(OpenFiles(i))

        ImportXL.Worksheets("Entries").Activate
        r = Cells(Rows.Count, "A").End(xlUp).Row
        Set Crng = Range(Cells(2, 1), Cells(r, 2))

        Crng.Copy

        Windows(Crntwrkbk).Activate
        Worksheets("Entries").Activate

        Cloc = Workbooks(Crntwrkbk).Worksheets("Entries").Range("A65536").End(xlUp).Offset(1).Row
        Worksheets("Entries").Range("A" & Cloc).PasteSpecial _
        Paste:=xlPasteValues

        Application.CutCopyMode = False

        ImportXL.Close True

Next i


'Application.ScreenUpdating = True
'Workbooks(Crntwrkbk).Activate

End Sub

Any assistance appreciated.

When you use `.Activate` and `.Select` you are just asking for a debugging nightmare. Learn to avoid it. https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba — K.Dᴀᴠɪs, Jan 30 '18 at 20:40
Before your loop `debug.print UBound(OpenFiles)` and `debug.print n`, what are your results? — dwirony, Jan 30 '18 at 20:48
Not sure how i did not mentally process the link. the immediate window using debug is showing the number from n for number of files when i use the debug above — jwb2j, Jan 30 '18 at 21:14
@jwb2j and you're sure `UBound(OpenFiles)` equals `n`? I am guessing that they're not and that's why your loop is crashing. — dwirony, Jan 30 '18 at 21:39
i worked out how to take the activates out of the code and it now works like a charm. Thank you — jwb2j, Jan 30 '18 at 21:44

score 0 · Answer 1 · answered Jan 30 '18 at 22:00

This is untested but looks correct to me (though this might eb a good learning exercise for you to figure out if it isnt working correctly).

Its a way to use arrays, dynamic ranges and late binding to move data around. Plus its a good exercise/refresher in some parts of the excel object model.

Happy coding!

Public Sub ImportUpdates()
    Dim ImportXL As Workbook
    Dim OpenFiles() As Variant
    Dim pickUp as Variant
    Dim i As Long, n As Long, iXLRowC As Long, iXLColC As Long, cWbkRowC As LONG, cWbkColC As Long
    Dim Crntwrkbk As String
    Application.ScreenUpdating = False
    Crntwrkbk = ThisWorkbook.Name
    OpenFiles = Application.GetOpenFilename(Title:="Select File(s) To Import", MultiSelect:=True)
    n = Application.CountA(OpenFiles)
    For i = 1 To n
        Set ImportXL = Workbooks.Open(OpenFiles(i))
        With ImportXL
            iXLRowC = .WorkSheets("Entries").UsedRange.Rows.Count
            iXLColC = .WorkSheets("Entries").UsedRange.Columns.Count
            pickUp = .WorkSheets("Entries").Range(.WorkSheets("Entries").Cells(2,1), .WorkSheets("Entries").Cells(iXLRowC, iXLColC)).Value
        End with
        With Crntwrkbk
            cWbkRowC = .WorkSheets("Entries").UsedRange.Rows.Count
            cWbkColC = .WorkSheets("Entries").UsedRange.Columns.Count
            .Worksheets("Entries").Range(.Worksheets("Entries").Cells(cWbkRowC+1, .Worksheets("Entries").Cells(cWbkColC+1), _
                .WorkSheets("Entries").Cells(cWbkRowC+1+iXLRowC, cWbkColC+1+iXLColC))).Value2 = pickUp
        End with
        Erase pickUp
        ImportXL.Close True
    Next i
    Application.ScreenUpdating = True
End Sub

Multiple work book paste crashing at 3+ files

1 Answers1