Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations Mike Lewis on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Speed up Macro 3

Status
Not open for further replies.
Jan 13, 2008
167
US
Hey guys I have a macro that reads a sheet then rearranges it and then reformats it. However it takes probably 2 to 3 minutes to run. This is with just Columns i'd say A -> O and about 250 lines.

Here is the code that takes the longest time:

Sheets("Build Sheet").Range("A2:A" & newLastRow).Value = Sheets("PreProcess Doc").Range("B2:B" & newLastRow).Value
Sheets("Build Sheet").Range("B2:B" & newLastRow).Value = Sheets("PreProcess Doc").Range("R2:R" & newLastRow).Value
Sheets("Build Sheet").Range("C2:C" & newLastRow).Value = Sheets("PreProcess Doc").Range("W2:W" & newLastRow).Value
Sheets("Build Sheet").Range("D2:D" & newLastRow).Value = Sheets("PreProcess Doc").Range("T2:T" & newLastRow).Value
Sheets("Build Sheet").Range("E2:E" & newLastRow).Value = Sheets("PreProcess Doc").Range("U2:U" & newLastRow).Value
Sheets("Build Sheet").Range("F2:F" & newLastRow).Value = Sheets("PreProcess Doc").Range("V2:V" & newLastRow).Value
Sheets("Build Sheet").Range("G2:G" & newLastRow).Value = Sheets("PreProcess Doc").Range("D2:D" & newLastRow).Value
Sheets("Build Sheet").Range("H2:H" & newLastRow).Value = Sheets("PreProcess Doc").Range("M2:M" & newLastRow).Value
Sheets("Build Sheet").Range("I2:I" & newLastRow).Value = Sheets("PreProcess Doc").Range("J2:J" & newLastRow).Value
Sheets("Build Sheet").Range("J2:J" & newLastRow).Value = Sheets("PreProcess Doc").Range("N2:N" & newLastRow).Value
Sheets("Build Sheet").Range("K2:K" & newLastRow).Value = Sheets("PreProcess Doc").Range("K2:K" & newLastRow).Value
Sheets("Build Sheet").Range("L2:L" & newLastRow).Value = Sheets("PreProcess Doc").Range("P2:p" & newLastRow).Value
Sheets("Build Sheet").Range("M2:M" & newLastRow).Value = Sheets("PreProcess Doc").Range("G2:G" & newLastRow).Value

it reads from one sheet and puts it on another by using ranges.

Is there anyway to speed this process us?

Also once it redoes everything it says "Calculating" in the bottom left is this necessary? If asked i'll try to upload a copy of the macro or the code. Just trying to get the ball rolling
 
nevermind it didn't work... it's not liking me obviously!
 
I'n not 'really' a programmer, so maybe what you're doing is just over my head, but that looks way overcomplicated.

What exactly are you trying to accomplish? Have you tried simply renaming the file (if that is even needed) then deleting whatever you no longer want?

[tt]_____
[blue]-John[/blue][/tt]
[tab][red]The plural of anecdote is not data[/red]

Help us help you. Please read FAQ 181-2886 before posting.
 
Try this

Code:
Application.ScreenUpdating = False
Application.Calculation = xlManual


Sheets("Build Sheet").Range("A2:A" & newLastRow).Value = Sheets("PreProcess Doc").Range("B2:B" & newLastRow).Value
    Sheets("Build Sheet").Range("B2:B" & newLastRow).Value = Sheets("PreProcess Doc").Range("R2:R" & newLastRow).Value
    Sheets("Build Sheet").Range("C2:C" & newLastRow).Value = Sheets("PreProcess Doc").Range("W2:W" & newLastRow).Value
    Sheets("Build Sheet").Range("D2:D" & newLastRow).Value = Sheets("PreProcess Doc").Range("T2:T" & newLastRow).Value
    Sheets("Build Sheet").Range("E2:E" & newLastRow).Value = Sheets("PreProcess Doc").Range("U2:U" & newLastRow).Value
    Sheets("Build Sheet").Range("F2:F" & newLastRow).Value = Sheets("PreProcess Doc").Range("V2:V" & newLastRow).Value
    Sheets("Build Sheet").Range("G2:G" & newLastRow).Value = Sheets("PreProcess Doc").Range("D2:D" & newLastRow).Value
    Sheets("Build Sheet").Range("H2:H" & newLastRow).Value = Sheets("PreProcess Doc").Range("M2:M" & newLastRow).Value
    Sheets("Build Sheet").Range("I2:I" & newLastRow).Value = Sheets("PreProcess Doc").Range("J2:J" & newLastRow).Value
    Sheets("Build Sheet").Range("J2:J" & newLastRow).Value = Sheets("PreProcess Doc").Range("N2:N" & newLastRow).Value
    Sheets("Build Sheet").Range("K2:K" & newLastRow).Value = Sheets("PreProcess Doc").Range("K2:K" & newLastRow).Value
    Sheets("Build Sheet").Range("L2:L" & newLastRow).Value = Sheets("PreProcess Doc").Range("P2:P" & newLastRow).Value
    Sheets("Build Sheet").Range("M2:M" & newLastRow).Value = Sheets("PreProcess Doc").Range("G2:G" & newLastRow).Value

Application.Calculation = xlAutomatic
Application.ScreenUpdating = True

[/code

See if this speeds up any

ck1999
 
I have done those two and it does speed it up but by like 10 seconds at most.

What that code is doing is taking data from one row in "Build Sheet" and copying it to a different row in "PreProcess Doc". That isn't all the code it's just part of it.
 
Have you done a time test before and after this section of code. There is a thread (maybe even a faq) that has the vba to use as a good timing code.

I tested this on my computer and it took only seconds. Only with text and number there was no calculations in my sheet.


Chris
 
it runs alot faster if the "Build sheet" is opened. Is there anyway to open that via code?
 
ck1999: the problem isn't turning off this or that - it is the approach that is being taken. Before refining to the degree you're talking about, he's going to need to change the strategy.

mattloflin: It seems to be copying over columns, not rows. But the problem is that your technique is needlessly complex. You're simply asking Excel to do a lot more steps that you need to. First, you could get rid of the bit that calculates the range size on the Build sheet. Just copying
Sheets("PreProcess Doc").Range("B2:B" & newLastRow) to Sheets("Build Sheet").Range("A2") would suffice.

But, like I said, I think you should change the whole approach.

Try this:
Code:
'...
Sheets("PreProcess Doc").Copy Before:=Sheets("PreProcess Doc")
Sheets("PreProcess Doc (2)").Name = "Build Sheet"

Range("A:A,C:C,E:F,H:H,I:I,L:L,O:O,Q:Q,S:S").Delete 'Shift:=xlToLeft
Columns("I:I").Cut
Range("B1").Insert Shift:=xlToRight
Columns("M:M").Cut
Range("C1").Insert Shift:=xlToRight
Columns("K:M").Cut
Range("D1").Insert Shift:=xlToRight
'Columns("K:K").Select
'Selection.Cut
Columns("K:K").Cut
Range("H1").Insert Shift:=xlToRight
Columns("J:J").Cut
Range("I1").Insert Shift:=xlToRight
Columns("L:L").Cut
Range("J1").Insert Shift:=xlToRight
Columns("K:K").Cut
Range("N1").Insert Shift:=xlToRight
'...
That could probably be improved upon, but it runs in well less than 1 second.

Also, as a general rule avoid Select and Activate whenever possible. They take too long.

[tt]_____
[blue]-John[/blue][/tt]
[tab][red]The plural of anecdote is not data[/red]

Help us help you. Please read FAQ 181-2886 before posting.
 
anotherhiggins I tried that code and it keeps coming up with range issues.

I don't think that code works with the code I provied. I commented out my code and tried to run yours and it's not liking it.

After it does your code I have other code that runs and checks the cells to see if they have certain criteria and if they do it shades the cell color.
 
Try this:

Copy your "PreProcess Doc" sheet to a new file all by itself. Now run my code. It should produce the layout you're looking for, as far as order of columns.

I haven't seen whatever code comes after that yet, so it might not work together. I'll download your macro and take a look when I get a minute.



[tt]_____
[blue]-John[/blue][/tt]
[tab][red]The plural of anecdote is not data[/red]

Help us help you. Please read FAQ 181-2886 before posting.
 
Looking at your code now....

No one is going to go through 414 lines of code with a fine tooth comb - but you obviously don't expect that, that's why you just posted the chunk above.

Here's an example of avoiding Select from the beginning of your macro. I've also gotten rid of unnecessary calculations of how many rows there are.... If you are deleting everything in a column, just delete the column. I've commented out your original code and, below each section, offered alternate code that will run faster:
Code:
[green]'Remove unwanted columns

'    Old Code Commented Out
'    Range("N1:Q" & LastRow).Select
'    Selection.Delete[/green]
    Range("N:Q").Delete
    
[green]'    Range("C:C").Select
'    Selection.Delete[/green]
    Range("C:C").Delete
    
[green]'    Range("A1:B" & LastRow).Select
'    Selection.Cut[/green]
    Range("A:B").Cut
    
[green]'    Range("K:K").Select
'    Selection.Insert Shift:=xlToRight[/green]
    Range("K:K").Insert Shift:=xlToRight
Macro Recorder always spits out the
Range("C:C").Select
Selection.Delete
type of layout. I think it's worth the time to clean all the mess up as shown in my example.

[tt]_____
[blue]-John[/blue][/tt]
[tab][red]The plural of anecdote is not data[/red]

Help us help you. Please read FAQ 181-2886 before posting.
 
I see, interesting. I'm not asking for someone to go through the code. It runs in about 14 seconds. I just think that the part that I plotted is the 13.5 second part.

If you try your code in my a file it come sup with range errors and that's what I was asking. I understand your concept and think it'll rock. Just can't get it running
 
This will even speed thing up
Code:
 Range("A2:Z" & ((2 * LastRow) - 1)).Sort Key1:=Range("A2"), Order1:=xlAscending, Key2:=Range("C2") _
        , Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
        False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2 _
        :=xlSortNormal]

Dave Morrison
 
Code:
'...
Sheets("PreProcess Doc").Copy Before:=Sheets("PreProcess Doc")
Sheets("PreProcess Doc (2)").Name = "Build Sheet"

Range("A:A,C:C,E:F,H:H,I:I,L:L,O:O,Q:Q,S:S").Delete 'Shift:=xlToLeft
Columns("I:I").Cut
Range("B1").Insert Shift:=xlToRight
Columns("M:M").Cut
Range("C1").Insert Shift:=xlToRight
Columns("K:M").Cut
Range("D1").Insert Shift:=xlToRight
'Columns("K:K").Select

this throws a few runtime errors, first of which is a 1004 saying cannot rename a sheet to the same name... etc

Code:
 Range("A2:Z" & ((2 * LastRow) - 1)).Sort Key1:=Range("A2"), Order1:=xlAscending, Key2:=Range("C2") _
        , Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
        False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2 _
        :=xlSortNormal]

not sure where this goes, however if it was indtended to replace my data all it does and make it all disappear... good magic trick though :)

Any ideas?
 
Code:
Sheets("Build Sheet").Range("A:A") = Sheets("PreProcess Doc").Range("B:B")

Higgins,
I tried this, it didn't work. it comes up with a ref# errors.
 
Change the top of the code to this.

Code:
Application.DisplayAlerts = False
Sheets("build sheet").Delete
Sheets("PreProcess Doc").Copy Before:=Sheets("PreProcess Doc")
Sheets("PreProcess Doc (2)").Name = "Build Sheet"
Application.DisplayAlerts = True

Did you read the error 1004!

How long is all your code taking?

ck1999
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top