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/showthread.php?47288-Excel-Crashes-and-macro-runs-slow&p=295828&viewfull=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'.