Excel bombs out in macro...help please!!

S

SanFranGuy06

I'm created a workbook that opens other files, copies data, filters it,
then deletes all the unwanted lines. The problem I have is that it's 80
worksheets in this one file and I the macro goes through 80 separate
files, one at a time, and then closes it down after it is done copying
the lines. Having so much data, Excel craps out and tells me that there
aren't enough resources to finish the action. I believe this happens
somewhere halfway through the sheets at the line:
Selection.AutoFill Destination:=Range("F7:F4000")
So my question is whether or not there is a better way to write the
below that will filter out for the lines that I want:
ActiveCell.FormulaR1C1 = "=RC[-5]=R1C2"
without having to fill 40,000 cells with formulas over 80 separate
worksheets. Thanks so much in advance for any help possible!!


Sub Import_Files()
If Range("B4").Value = """" Then
Exit Sub
End If
Dim WB As Workbook
Set WB = Workbooks.Open(Filename:="N:\test\" & Range("B4").Value)
Range("A1:E40000").Select
Selection.Copy
For Each myworkbook In Application.Workbooks
If myworkbook.FullName = ThisWorkbook.FullName Then
myworkbook.Activate
Next myworkbook
Range("A6").Select
ActiveSheet.Paste
Application.CutCopyMode = False
WB.Close Savechanges:=False
Range("F7").Select
ActiveCell.FormulaR1C1 = "=RC[-5]=R1C2"
Range("F7").Select
Selection.AutoFill Destination:=Range("F7:F4000")
Range("F7:F40000").Select
Range("A6:F6").Select
Range("F6").Activate
Selection.AutoFilter
Selection.AutoFilter Field:=6, Criteria1:="FALSE"
Rows("7:40000").Select
Selection.Delete Shift:=xlUp
Selection.AutoFilter Field:=6, Criteria1:="TRUE"
Columns("F:F").Select
Selection.AutoFilter Field:=6
Selection.Delete Shift:=xlToLeft
Selection.AutoFilter
Range("B6:B40000").Select
With Selection.HorizontalAlignment = xlRight
End With
Range("A6").Select

End Sub
 
B

Brian Taylor

I think your main resource drain is when you delete 40,000 lines:

Rows("7:40000").Select
Selection.Delete Shift:=xlUp

As a side thought you can make your code more efficient by removing the
select statements (vba doesn't need them since it isn't a user)

Rows("7:40000").Delete Shift:=xlUp

You should use this line instead:

Rows("7:40000").ClearContents

Deleting a lot of rows takes a while. Also you probably should turn
the calculation off and then on again when you are done:

Application.calculation = xlManual

code.....

Application.calculation = xlAutomatic
 
S

SanFranGuy06

I tried it but it still doesn't work. Looks like it still gets caught
up at around the same sheet. Debugging shows that the exact line it
actually stops on is here

Range("A6").Select
---> ActiveSheet.Paste
Application.CutCopyMode = False

Thanks for trying though Brian!
 
S

SanFranGuy06

I tried it but it still doesn't work. Looks like it still gets caught
up at around the same sheet. Debugging shows that the exact line it
actually stops on is here

Range("A6").Select
---> ActiveSheet.Paste
Application.CutCopyMode = False

Thanks for trying though Brian!
 
D

Dave Peterson

This is untested, but it did compile...

But first a couple of questions/comments. You rely on the worksheets you need
to be in the correct location when you need them. If you open a workbook that
was saved with the "wrong" workbook active, you may not copy the correct range.
If I know my workbooks, I'll use the worksheet names when I can.

And you're copying A1:E40000. Instead of copying that big old range, can you
rely on a column that has data in it--say column A--that can be used to find the
last row to copy.

And sometimes when you copy something, then do stuff in between, when you're
ready to paste the clipboard has been lost. It's usually better to copy right
before you do the paste.

To make life easier, you can define a range name that corresponds to that range
that should be copied. Set it when you know it, but copy it right before you
paste it.

And selecting stuff usually slows things down. It's usually much better to work
directly on that range (or object).

I _think_ that this does what your code does, but test it against a copy--just
in case. (Remember, it compiled, but I didn't test it!)

Option Explicit
Sub Import_Files()

Dim CurWks As Worksheet
Dim WB As Workbook
Dim ImpWks As Worksheet
Dim RngToCopy As Range
Dim RngToClean As Range

Set CurWks = ActiveSheet

With CurWks
'did you really mean = """" ????
If .Range("B4").Value = "" Then
Exit Sub
End If

Set WB = Workbooks.Open(Filename:="N:\test\" & .Range("B4").Value)
'I'd use the worksheet name here--just in case the imported
'workbook wasn't saved with the correct worksheet active
Set ImpWks = WB.Worksheets("sheet9999")
With ImpWks
Set RngToCopy = .Range("a1:E40000")
'or maybe use column A to find the last row??
'Set RngToCopy = .Range("a1:E" _
& .Cells(.Rows.Count, "A").End(xlUp).Row)
End With

RngToCopy.Copy _
Destination:=.Range("a6")

WB.Close Savechanges:=False

'use data in column A to find the last row to clean up
Set RngToClean = .Range("F6:F" _
& .Cells(.Rows.Count, "A").End(xlUp).Row)

With RngToClean
'put formula in F6, too
'but filtering will have row 6 as the header
'and column F is deleted later, so who cares?
.FormulaR1C1 = "=rc[-5]=r1c2"
'makes deleting faster
.Value = .Value
.AutoFilter field:=1, Criteria1:="False"
'just in case there are no False's
On Error Resume Next
.Cells.SpecialCells(xlCellTypeVisible).EntireRow.Delete
On Error GoTo 0
'throw away that helper column
.EntireColumn.Delete
End With

.Range("B6:B" & .Cells(.Rows.Count, "A").End(xlUp).Row) _
.HorizontalAlignment = xlRight

End With

End Sub
I'm created a workbook that opens other files, copies data, filters it,
then deletes all the unwanted lines. The problem I have is that it's 80
worksheets in this one file and I the macro goes through 80 separate
files, one at a time, and then closes it down after it is done copying
the lines. Having so much data, Excel craps out and tells me that there
aren't enough resources to finish the action. I believe this happens
somewhere halfway through the sheets at the line:
Selection.AutoFill Destination:=Range("F7:F4000")
So my question is whether or not there is a better way to write the
below that will filter out for the lines that I want:
ActiveCell.FormulaR1C1 = "=RC[-5]=R1C2"
without having to fill 40,000 cells with formulas over 80 separate
worksheets. Thanks so much in advance for any help possible!!

Sub Import_Files()
If Range("B4").Value = """" Then
Exit Sub
End If
Dim WB As Workbook
Set WB = Workbooks.Open(Filename:="N:\test\" & Range("B4").Value)
Range("A1:E40000").Select
Selection.Copy
For Each myworkbook In Application.Workbooks
If myworkbook.FullName = ThisWorkbook.FullName Then
myworkbook.Activate
Next myworkbook
Range("A6").Select
ActiveSheet.Paste
Application.CutCopyMode = False
WB.Close Savechanges:=False
Range("F7").Select
ActiveCell.FormulaR1C1 = "=RC[-5]=R1C2"
Range("F7").Select
Selection.AutoFill Destination:=Range("F7:F4000")
Range("F7:F40000").Select
Range("A6:F6").Select
Range("F6").Activate
Selection.AutoFilter
Selection.AutoFilter Field:=6, Criteria1:="FALSE"
Rows("7:40000").Select
Selection.Delete Shift:=xlUp
Selection.AutoFilter Field:=6, Criteria1:="TRUE"
Columns("F:F").Select
Selection.AutoFilter Field:=6
Selection.Delete Shift:=xlToLeft
Selection.AutoFilter
Range("B6:B40000").Select
With Selection.HorizontalAlignment = xlRight
End With
Range("A6").Select

End Sub
Click to expand...
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

How do I exit on blank cell? 2
Different Results from the Same Macro 3
Cleanup this macro please 3
Help with VBA Script 4
Macro that deletes and pastes filterd rows and then some 2
Autofilter in MACRO doesn't work 0
Filter in MACRO doesn't work 0
macro to copy rows that contain a cell with a certain number 3

Top