Excel crashes during simple VBA (open file, copy, paste, close) in a loop

Question

I am a new Excel 2013 vba programmer. I have written code to loop through each file in a folder, open it, copy the cells, and paste to a new file, increment down a row, and do this for each file in the folder.

Before I loop to the next file, I close the previous one. There are about 120 files in the folder. This is ultimately to create an index of the data in the folder in a single file.

This seems to run fine when I "step through", but if I just F5 the macro it runs for a while, I see it working fine, and then part way through it crashes Excel "Excel has stopped working..." it just shuts down.

Have you ever run into this before? Any suggestions? Here's the subset of the code that does the work:

Sub WorkHorse()
    ' Application.DisplayAlerts = False 'large amount of data in clipboard, do you want to keep..." message_ *MUST TURN BACK ON SEE BELOW!!

    ChDir "R:\ISO\Sticks\307M"
    myFile = Dir("*.xlsx")


    Do Until myFile = ""
        Workbooks.Open Filename:=myFile
        If Range("A3") = "" Then
            Range("A2").Select
            Range(Selection, Selection.End(xlToRight)).Select
        End If
        If Range("A3") <> "" Then
            Range("A2").Select
            Range(Selection, Selection.End(xlToRight)).Select
            Range(Selection, Selection.End(xlDown)).Select
        End If
        Selection.Copy
        Windows("Test for Possanza Aug 2015.xlsm").Activate
        ActiveSheet.Paste
        Range("A1").Select
        ActiveSheet.Range("A1").Copy
        Selection.End(xlDown).Select
        ActiveCell.Offset(1, 0).Range("a1").Select
        Windows(myFile).Close
        myFile = Dir
    Loop

    ' Application.DisplayAlerts = True 'this re-enables Display Alerts in MSOffice. *CRITICAL TO TURN BACK ON!

End Sub

Hi everyone thanks for the help. Feel free to advise me on how to add new code with additional comments/questions -- this is new to me.
Per my comment below and your suggestions I have modified the code. I haven't tried it with Davesexcel's fix yet, but when it didn't work yesterday I did some digging and found a CurrentRegion command that seems to work except it includes the header line (row 1) from each of the files being copied. The information I found said it assumes a header row and does not include it, but that doesn't seem to be happening. Here's my new code, suggestions very much appreciated. ALSO, the one commented line -- why doesn't that work? it errors out. I was trying to be specific regarding workbook and worksheet (always the first worksheet in the workbook, but name varies), per the suggestions you pointed me to. Thanks.

   Sub ReDoWorkHorseWithoutSelect()
    Dim myfile As String
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim DataBlock As Range

    Set wb = Workbooks("Test for Possanza Aug 2015.xlsm")
    Set ws = wb.Sheets("Sheet1")    'change desired sheet

    ChDir "R:\ISO\Sticks\307M"
    myfile = Dir("*.xlsx")

    Do Until myfile = ""
        Workbooks.Open Filename:=myfile
'       Set DataBlock = Workbooks("myfile").Worksheets(1).Range("A1").CurrentRegion
        Set DataBlock = Range("A2").CurrentRegion
        DataBlock.Copy ws.Cells(ws.Rows.Count, "A").End(xlUp).Offset(1)
        Windows(myfile).Close
        myfile = Dir
    Loop

Avoid using `Select`: http://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba-macros — Jean-François Corbett, Sep 08 '15 at 14:04

Davesexcel · Accepted Answer · 2015-09-08T20:47:32.000

5

Could be to many selects, or ranges being selected.

How about something like this so you don't have to use selects

Dim wb As Workbook, ws As Worksheet
Dim rng2 As Range
Dim Crng As Range


Set wb = Workbooks("Test for Possanza Aug 2015.xlsm")
Set ws = wb.Sheets("Sheet1")    'change desired sheet

'other code


Do Until myFile = ""
    Workbooks.Open Filename:=myFile
    Set rng2 = Range("A2")
    If rng2 = "" Then
        Set Crng = Range(rng2, rng2.End(xlToRight))
    Else
        r = Cells(Rows.Count, "A").End(xlUp).Row
        c = Cells(2, Columns.Count).End(xlToRight).Column
        Set Crng = Range(Cells(2, 1), Cells(r, c))
    End If

    Crng.Copy ws.Cells(ws.Rows.Count, "A").End(xlUp).Offset(1)


    Windows(myFile).Close
    myFile = Dir
Loop

Possible use

myfile.close true

then you wouldn't have to worry about "displayalerts" you would have to test it out though.

edited Sep 08 '15 at 20:47

answered Sep 08 '15 at 12:40

Davesexcel

6,896
2
27
42

1

fixed `Set Crng = Range(Cells(2, 1), Cells(r, c))` – Davesexcel Sep 08 '15 at 20:48
Hi everyone, Thanks for all the help. I ended up following Davesexcel code but found a "select current region" function that seems to dramatically simplify the code. And it works with one exception -- I can't figure out how to eliminate the header rows. Also, I can't understand why the syntax on one line (that I commented out because I found a workaround) doesn't work. Just wondering for future reference. How do I paste my new code into this string, it tells me I am out of characters in this comment box? – liroch Sep 09 '15 at 11:47
1

You can edit your original question and add the code there. – Davesexcel Sep 09 '15 at 12:14

Excel crashes during simple VBA (open file, copy, paste, close) in a loop

1 Answers1