?
Solved

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

Posted on 2011-03-25
12
Medium Priority
?
232 Views
Last Modified: 2012-08-13
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

0
Comment
Question by:gabrielPennyback
  • 4
  • 3
  • 2
  • +2
11 Comments
 
LVL 43

Expert Comment

by:Saqib Husain, Syed
ID: 35219620
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
0
 
LVL 48

Expert Comment

by:jpaulino
ID: 35219622
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"
0
 
LVL 43

Expert Comment

by:Saqib Husain, Syed
ID: 35219634
Also move

ThisWorkbook.Activate

to below the "Next"
0
Concerto's Cloud Advisory Services

Want to avoid the missteps to gaining all the benefits of the cloud? Learn more about the different assessment options from our Cloud Advisory team.

 
LVL 1

Author Comment

by:gabrielPennyback
ID: 35219695
Hi ssaquib, thanks. I get a syntax error on all the lines beginning with cstr. Do I need to define it as a variable?
0
 
LVL 43

Expert Comment

by:Saqib Husain, Syed
ID: 35219700
Sorry, I did try to define but made a mistake.

Change dim str.... to dim cstr...
0
 
LVL 6

Expert Comment

by:FernandoFernandes
ID: 35219892
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 :)
0
 
LVL 6

Assisted Solution

by:FernandoFernandes
FernandoFernandes earned 800 total points
ID: 35219946
ok, no need to sort...
use the code below:

 
Option Explicit

Sub MakeExceptions()
Dim oCells      As Range
Dim pastePt     As Range
Dim arrAllCells As Variant
Dim lCounter    As Long

    With Application
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
    End With

    arrAllCells = Range("AC6:AC756")
    If VBA.IsArray(arrAllCells) Then
        For lCounter = LBound(arrAllCells) To UBound(arrAllCells)
            If arrAllCells(lCounter, 1) = 1 Then
                If oCells Is Nothing Then
                    Set oCells = ActiveSheet.Cells(lCounter + 5, 1).EntireRow
                Else
                    Set oCells = Application.Union(oCells, ActiveSheet.Cells(lCounter + 5, 1).EntireRow)
                End If
            End If
        Next
    End If
    If Not oCells Is Nothing Then
        oCells.Copy
        Windows("Exceptions.xls").Activate
        Set pastePt = [TopA].End(xlDown).Offset(1, 0)
        pastePt.PasteSpecial Paste:=xlPasteAll
        oCells.Delete Shift:=xlUp
    End If
    
    With Application
        .Calculation = xlCalculationAutomatic
        .CutCopyMode = False
        .ScreenUpdating = True
    End With
    
End Sub

Open in new window

0
 
LVL 81

Accepted Solution

by:
byundt earned 1200 total points
ID: 35219959
John,
I suggest moving the Window activate statement outside of the loop. You only need to reference it once to set your pointer.
Sub MakeExceptions()
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Dim cel As Range, pastePt As Range
Dim i As Long
Windows("Exceptions.xls").Activate
Set pastePt = [TopA].End(xlDown)
ThisWorkbook.Activate

For Each cel In Range("AC6:AC756")
  If cel = 1 Then
    i = i + 1
    cel.EntireRow.Cut pastePt.Offset(i, 0)
  End If
Next
Application.CutCopyMode = False
'Call DeleteExceptions
Application.ScreenUpdating = True
End Sub

Open in new window

Brad
0
 
LVL 1

Author Comment

by:gabrielPennyback
ID: 35303511
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
0
 
LVL 1

Author Comment

by:gabrielPennyback
ID: 35774870
"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
0
 
LVL 1

Author Closing Comment

by:gabrielPennyback
ID: 36142774
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
0

Featured Post

Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Freeze panes is an option within all variants of Excel to enable parts of a sheet to remain stationary when the cursor is in another part of the sheet. This is a very useful feature which is overlooked or under used.
This article describes how to use a set of graphical playing cards to create a Draw Poker game in Excel or VB6.
The viewer will learn how to create a normally distributed random variable in Excel, use a normal distribution to simulate the return on an investment over a period of years, Create a Monte Carlo simulation using a normal random variable, and calcul…
This Micro Tutorial will demonstrate how to use longer labels with horizontal bar charts instead of the vertical column chart.

840 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question