Solved

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

Posted on 2011-03-25
12
223 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
12 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
 
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
Threat Intelligence Starter Resources

Integrating threat intelligence can be challenging, and not all companies are ready. These resources can help you build awareness and prepare for defense.

 
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 200 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 80

Accepted Solution

by:
byundt earned 300 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

Threat Intelligence Starter Resources

Integrating threat intelligence can be challenging, and not all companies are ready. These resources can help you build awareness and prepare for defense.

Join & Write a Comment

Sparklines have been introduced with Excel 2010 and are a useful tool for creating small in-cell charts, used for example in dashboards. Excel 2010 offers three different types of Sparklines: Line, Column and Win/Loss. What it does not offer is a…
Drop Down List with Unique/Distinct Values (Part II - ComboBox or ListBox and Data Validation List Bonus!) David Miller (dlmille) Intro This article focuses on delivering unique, sorted lists to list objects (e.g., ComboBox, ListBox) and Dat…
The viewer will learn how to create two correlated normally distributed random variables in Excel, use a normal distribution to simulate the return on different levels of investment in each of the two funds over a period of ten years, and, create a …
This Micro Tutorial will demonstrate how to create pivot charts out of a data set. I also added a drop-down menu which allows to choose from different categories in the data set and the chart will automatically update.

760 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

Need Help in Real-Time?

Connect with top rated Experts

20 Experts available now in Live!

Get 1:1 Help Now