asked on

Speeding up a code that cuts and pastes multiple non-contiguous ranges to an external workbook

How do I make this code faster and more elegant?

Thanks,
John

Sub MakeExceptions()
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Dim cel As Range
For Each cel In Range("AC6:AC756")
  If cel = 1 Then
    cel.EntireRow.Cut
    Windows("Exceptions.xls").Activate
        Dim pastePt As Range
        Set pastePt = [TopA].End(xlDown).Offset(1, 0)
    pastePt.Select
    ActiveSheet.Paste
  Else
  End If
  ThisWorkbook.Activate
Next
Application.CutCopyMode = False
'Call DeleteExceptions
Application.ScreenUpdating = True
End Sub

Open in new window

Saqib Husain

See if this routine helps

Sub MakeExceptions()
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Dim cel As Range
dim str as string
For Each cel In Range("AC6:AC756")
If cel = 1 Then
cstr=cstr & cel.row & ":" & cel.row
Windows("Exceptions.xls").Activate
Else
End If
ThisWorkbook.Activate
Next
cstr=right(cstr ,len(cstr)-1)
range(cstr).select
Dim pastePt As Range
Set pastePt = [TopA].End(xlDown).Offset(1, 0)
pastePt.Select
ActiveSheet.Paste

Application.CutCopyMode = False
'Call DeleteExceptions
Application.ScreenUpdating = True
End Sub

Jorge Paulino

If you have code that run on events, you can also turn it off, using Application.EnableEvents = False

You could also skip the selection (pastePt.Select) using just "ActiveSheet.Paste pastePt"

Saqib Husain

Also move

ThisWorkbook.Activate

to below the "Next"

John Carney

ASKER

Hi ssaquib, thanks. I get a syntax error on all the lines beginning with cstr. Do I need to define it as a variable?

Saqib Husain

Sorry, I did try to define but made a mistake.

Change dim str.... to dim cstr...

FernandoFernandes

i have another idea which will make your code so fast that you won't even have time to breath twice before it ends...

Just one quick question, can the code sort your table by the column AC ? (this will make it even faster)

p.s: I am already working on a new code, regardless of your answer :)

SOLUTION

FernandoFernandes

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

ASKER CERTIFIED SOLUTION

byundt

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

John Carney

ASKER

Looks like one or both of the last two answers lwill work. I'm anxious to try them but I won't be able to test them out til Monday when I get to work.

Thanks,
John

John Carney

ASKER

"Dim cstr as String..." I should have noticed that. :-) Fernando and Brad, yours look promising, I hope I actually do manage to check this out tomorrow. As I've been asking several other people tonight, pls forgive me for losing track of this question!

Thanks,
John

John Carney

ASKER

Man, where have I been! Brad and Fernando, yours both work faster than mine, thank you. Fernando, although it wasn't critical yours produced a REF error for some reason on one of the copied columns, which is why I gave Brad the extra points.

Ssaqibh, I tinkered with yours a lot but I just couldn't get it to work. Probably my ineptitude, sorry.\\Thanks,
John