Excel Crashes and macro runs slow

[Jarlisle]

I have a macro that goes through a given folder and opens the files and copies the data in a sheet and then adds it to a master file so that I can have one sheet that houses all my data. The problem I have is that the macro runs really slow and then it usually crashes excel on the second pass of the loop. Any help is appreciated.

Sub Macro1()'
' Macro1 Macro
'


'
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Dim MyFile As String
Dim MyCell As CellFormat
MyPath = InputBox("What folder are the files in?") & "\"
MyFile = Dir(MyPath)
Do While MyFile <> ""
If MyFile Like "*.xls" Then
Workbooks.Open MyPath & MyFile
    ActiveWorkbook.Sheets("Goods Out of Stock Summary").Select
    Range("C14").Copy
    Workbooks("Concession Sales Data.xlsm").Activate
    
    Range("C1").Select
    Selection.End(xlDown).Offset(1, -2).Select
    ActiveSheet.Paste
    
    Workbooks(MyFile).Activate
    Range("C12").Copy
    
    Workbooks("Concession Sales Data.xlsm").Activate
   
    Range("C1").Select
    Selection.End(xlDown).Offset(1, -1).Select
    ActiveSheet.Paste
    
    Workbooks(MyFile).Activate
    Range("A20:L20").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    
    Workbooks("Concession Sales Data.xlsm").Activate
    
    Range("C1").Select
    Selection.End(xlDown).Offset(1, 0).Select
    ActiveSheet.Paste


Workbooks(MyFile).Activate
ActiveWorkbook.Close True
End If
MyFile = Dir
Loop




Application.DisplayAlerts = True
Application.ScreenUpdating = True
i = MsgBox("Macro is done with this folder.", vbOKOnly, "Macro done.")


End Sub

[SamT]

Except for this line

MyFile = Dir(MyPath & "*.xls?")

the code below is structurally the same as before. I had to assume that all the copies were from the same sheet of the active (=newly opened) workbook.

In the Dir Function above the "*.xls?) segment will return any file with an extension = ".xls" or ".xls & [" "; 0-9; a-Z]. This is similar to "Like(.xls)" except it limits the possibilities to ".xls" and no more than one other character. If you are opening only one type of file, change the "?" to suit.

Option Explicit

Sub Macro1() '

Application.DisplayAlerts = False
Application.ScreenUpdating = False
Dim MyFile As String
Dim MyCell As CellFormat
Dim BottomOfC As Range
MyPath = InputBox("What folder are the files in?") & "\"

MyFile = Dir(MyPath & "*.xls?")
Do While MyFile <> ""
  Workbooks.Open MyPath & MyFile
  
  Set BottomOfC = Workbooks("Concession Sales Data.xlsm").Range("C1") _
            .End(xlDown).Offset(1, 0)
            
  With Workbooks(MyFile).Sheets("Goods Out of Stock Summary")
    .Range("C14").Copy BottomOfC.Offset(0, -2)
    .Range("C12").Copy BottomOfC.Offset(0, -1)
    .Range("A20:L20").End(xlDown).Copy BottomOfC
    .Close True
  End With
  MyFile = Dir
Loop
 
Application.DisplayAlerts = True
Application.ScreenUpdating = True
MsgBox "Macro is done with this folder.", vbOKOnly, "Macro done."

End Sub

[Jarlisle]

With a few tweaks I got this to run, but I'm struggling with this line

.Range("A20:L20").End(xlDown).Copy BottomOfC

I understand that it's getting one cell at the bottom of my data, but it actually needs to be the whole table. For instance when I was recording the macro I wanted the table that has the first line of A20:L20, but it could go for 100 or 150 lines and so my table to copy would end up being A20:L120. How would I change this line to get it what I want. I've tried several things and I'm just not a heavy user of VB to know what to do.

Here's what I have so far:

Sub Macro1()     
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    Dim MyFile As String
    Dim MyPath As String
    Dim BottomOfC As Range
    MyPath = InputBox("What folder are the files in?") & "\"
    MyFile = Dir(MyPath & "*.xls")
    
    Do While MyFile <> ""
        Workbooks.Open MyPath & MyFile
         
        Set BottomOfC = Workbooks("Concession Sales Data.xlsm").Sheets("Sheet1").Range("C1").End(xlDown).Offset(1, 0)
         
        With Workbooks(MyFile).Sheets("Goods Out of Stock Summary")
            .Range("C14").Copy BottomOfC.Offset(0, -2)
            .Range("C12").Copy BottomOfC.Offset(0, -1)
            .Range("A20:L20").End(xlDown).Copy BottomOfC
            ActiveWorkbook.Close True
        End With
        MyFile = Dir
    Loop
     
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    MsgBox "Macro is done with this folder.", vbOKOnly, "Macro done."
     
End Sub

[Aussiebear]

Name the table and set its property as dynamic

[SamT]

Select is the easiest

.Range("A20:L20").End(xlDown).Select
Selection.Copy BottomOfC

[SamT]

@ Aussiebear

Data Books, probably generated new each day.

[snb]

To speed it up:

Sub Macro1() 
  sn=createobject("wscript.shell").exec("cmd /c Dir G:\OF\*.xls /b").stdout.readall,vbcrlf)

  for each it in sn
    set x=Thisworkbook.Sheets("Sheet1").cells(rows.count,3).End(xlUp).Offset(1)

    with getobject(it)
      with .Sheets("Goods Out of Stock Summary") 
        x.offset(,-2).resize(,2)=arraY(.Range("C14").value,.Range("C12").value) 
        x.resize(.Range("A20:L20").End(xlDown).rows.count,12)=.Range("A20:L20").End(xlDown).Value
      end with 
      .Close false 
    End With 
  next
End Sub

Adapt the folderpath G:\OF to your situation.

[Jarlisle]

So I've got it to work with the following code, but it seems to crash Excel after doing 3 or 4 files. Any ideas?

Option Explicit 
Sub Macro1()
     
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    Dim MyFile As String
    Dim MyPath As String
    Dim BottomOfC As Range
    Dim BottomOfSheet As String
    MyPath = InputBox("What folder are the files in?") & "\"
    MyFile = Dir(MyPath & "*.xls")
    
    Do While MyFile <> ""
        Workbooks.Open MyPath & MyFile
         
        Set BottomOfC = Workbooks("Concession Sales Data.xlsm").Sheets("Sheet1").Range("C1").End(xlDown).Offset(1, 0)
        BottomOfSheet = Workbooks(MyFile).Sheets("Goods Out of Stock Summary").Range("A20").End(xlDown).Row
         
        With Workbooks(MyFile).Sheets("Goods Out of Stock Summary")
            .Range("C14").Copy BottomOfC.Offset(0, -2)
            .Range("C12").Copy BottomOfC.Offset(0, -1)
            .Range("A20:L" & BottomOfSheet).Copy BottomOfC
        End With
        
        ActiveWorkbook.Close True
        
        MyFile = Dir
    Loop
     
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    MsgBox "Macro is done with this folder.", vbOKOnly, "Macro done."
     
End Sub

[snb]

Yes, see http://www.vbaexpress.com/forum/show...l=1#post295828

[Jarlisle]

I appreciate your willingness to help snb, but I don't fully understand the code you gave and so when I get errors with it I can't figure out how to modify it. When I copy and past your code, right off the bat the first line goes red and so obviously when I try to run it, it will error out. I replaced G:\OF with my network folder like you suggested, but that didn't seem to work. I'd love to learn what you did, but I just don't understand it.

[snb]

No problem use

    sn = Split(CreateObject("wscript.shell").exec("cmd /c Dir G:\OF\*.xls /b").stdout.readall, vbCrLf)

You may have to adapt 'Sheet1" as well.

[Jarlisle]

What is it doing on the first line?

sn = Split(CreateObject("wscript.shell").exec("cmd /c Dir G:\OF\*.xls /b").stdout.readall, vbCrLf)

I get "Variable not defined". What do I need to declare it as? Is it an object? Am I not understanding correctly?

[Jarlisle]

That code snippit didn't copy paste correctly.

Here's what I have:

sn = Split(CreateObject("wscript.shell").exec("cmd /c Dir C:\My Documents\*.xls /b").stdout.readall, vbCrLf)

[Kenneth Hobs]

When testing code, break it into parts.

For shell code, click Start, select Run, and type, CMD, and press Enter key. To get help for a shell command like Dir type, Help Dir, and press enter key. ?Dir and enter key can be used as well. Type, c:, and press enter key to move the root to the c: drive. Then type, dir my documents, and press enter key. You will see that you need to encapsulate my documents in quotes, Dir "My Documents", which is really, Dir "c:\My Documents". To exit the command shell, type, Exit, and press enter key.

In the VBE, if you don't know what a command like Split does, put your cursor in or next to the command word and press F1 or press F2 and browse for the command word.

The stdout.readall simply returns the results of the screen output in the shell to a text stream and directly into the variable sn in this case.

You now know the why.

[snb]

Like KH mentioned:

sn = Split(CreateObject("wscript.shell").exec("cmd /c Dir ""C:\My Documents\*.xls"" /b").stdout.readall, vbCrLf)

Now you see why avoiding spaces in foldernames/filenames can be very practical.

If necessary comment out 'option explicit' to avoid the message 'variable not defined'.