Macro is amazingly SLOW...Need help

[anshu]

Hi All,

I am stuck with a problem and would need some expert advice. The issue
is to find a faster way to run a particular macro.

I am working on a macro which calls a file (call it data file), copies
the data, dumps it into the source file and then delete the rows which
I dont need. (2 out of every 3 rows) The range to be copied was
A1:FI499. I was running it in 5-10 seconds.

now, the data file has grown bigger and the range to be copied is
A1:FI1000. I ran the macro and it just doesnt move. I tried stepping
into the macro and running by pressing F8 continuously to check where
is it getting stuck. Copy paste was perfect but it was getting stuck
when I am deleting the rows which I dont need. Its very very slow.

I am writing the code which I was using..Please tell me if there is a
better (and faster) was to do it.

Windows("Data File.xls").Activate
Sheets("Data").Select
Range("A1:FI499").Select
Selection.Copy
Windows("Working Sheet.xls").Activate ' this is the main sheet
Sheets("Data").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
'Now I have some data in Column E which I need to delete
selectively...Essentially...I need to keep Row 4, Row7, 'Row 10, Row
13 etc......and delete all the rows all the way to the bottom ...This
is what I am doing to accomplish 'it
Range("E1").Select
Application.CutCopyMode = False
For i = 1 To 500
ActiveCell.Offset(1, 0).Select
Selection.EntireRow.Delete
Selection.EntireRow.Delete
Next i

--------------------

This was working fine with 500 rows..Since my rows have increased to
700..it has become terribly slow...on average, one row is deleted
every 2 seconds...( I saw it by making the Application Screenupdating
True )..This was it will take 30 minutes for 1000 rows..this is
unimaginable..please help

Thanks,
Anshuman

 

[Bob Phillips]

This is not tested but should be quicker

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Windows("Data File.xls").Activate
Sheets("Data").Range("A1:FI499").Copy
Windows("Working Sheet.xls").Activate ' this is the main sheet
Sheets("Data").Range("A1").PasteSpecial Paste:=xlPasteValues,
Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'Now I have some data in Column E which I need to delete _
selectively...Essentially...I need to keep Row 4, Row7, 'Row 10, Row _
13 etc......and delete all the rows all the way to the bottom ...This _
is what I am doing to accomplish 'it
Rows("1:500").Delete

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True





--
HTH

Bob

(there's no email, no snail mail, but somewhere should be gmail in my addy)

 

[excelent]

Sub Speedy()

For t = 2 To 1000 Step 3
Cells(t, 1) = ""
Cells(t + 1, 1) = ""
Next
Range("A1:A1000").SpecialCells(xlCellTypeBlanks).EntireRow.Delete

End Sub


"Bob Phillips" skrev:

 

[Toppers]

Try:

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Windows("Data File.xls").Activate
Sheets("Data").Select
Range("A1:FI499").Select
Selection.Copy
Windows("Working Sheet.xls").Activate ' this is the main sheet
Sheets("Data").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False

For i = 2 To 500
Cells(i, "A").Resize(2, 1).EntireRow.Delete
Next i

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

 

[anshu]

i am testing it now but you have deleted all rows from 1 to 500 in
the end...how will it preserve row 4,7,10 etc ? Will let you know if
the first part speedens things

 

[anshu]

Now, consider the problem as this:

I have a sheet with data from Cell A1 to Cell FI1000

I just need the data in Rows 4, 7, 10 , 13 , 16 etc..... and need to
delete all other rows...

I am using this right now


This method is very very slow for some reason

Can you suggest some fast method....

thanks,
Anshuman

 

[anshu]

didnt see the above 2 posts...let me check and I will get back

 

[anshu]

Excelent,

That was excellent....It is back to normal speed..I tried with 5000
rows also..

thanks everyone for taking the pain in replying so fast....I am really
amazed by the power of this group and the commitment of you
people....May be someday I will become an expert and help continue
building this group..

Thanks again,
Anshuman