Need to Speed Up A Macro

  • Thread starter Thread starter LostInNY
  • Start date Start date
L

LostInNY

I am using the following code for 10 sheets in the same workbook. It works,
but it takes about 4 minutes to run. The 10 spreadsheets contain formulas
which I do not want in the final version. I am performing an advance filter
on each sheet and copying this info to another spreadsheet and copying back
values only to the original spreadsheet. Effective, but very time consuming.
I am using Excel 2003. Any suggestions on how to speed this up?


Sheets("sheet1").Select
Range("A1:D3000").AdvancedFilter Action:=xlFilterInPlace, Unique:=True
Rows("1:3001").Select
Selection.Copy
Sheets("CopyWorkSheet").Select
Cells.Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=True, Transpose:=False
Sheets("Sheet1").Select
Application.CutCopyMode = False
On Error Resume Next
ActiveSheet.ShowAllData
On Error GoTo 0
Sheets("CopyWorkSheet").Select
Cells.Select
Selection.Copy
Sheets("sheet1").Select
 
Try adding

Application.Screenupdating = False
Application.Calculation = xlCalculationmanual

at the beginning and

Application.Screenupdating = True
Application.Calculation = XLCalculationAutomatic

at the end. If you have any code triggered by events, you'll probably want
to turn that off as well.

HTH,
Barb Reinhardt
 
Additional to Barb's suggestions which should go a long way to amking things
faster you can remove the slects from your code to add a touch more speed...


with Sheets("sheet1")
.Range("A1:D3000").AdvancedFilter Action:=xlFilterInPlace, Unique:=True
.Rows("1:3001").Copy
Sheets("CopyWorkSheet").Cells.PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
On Error Resume Next
ActiveSheet.ShowAllData
On Error GoTo 0
Sheets("CopyWorkSheet").Cells.Copy
Sheets("sheet1").Select
End With
 
Back
Top