Help Make Code Faster

[dignityy]

I have written the following procedure to copy/sort & delete all the zero rows, the problem is that it takes over a minute to run this code. This is compounded by the fact that I have this same macro for each month of the year and when I run my main macro which runs all 12 months consecutively the whole process takes 19 minutes. Following is the code for one month and then the main macro which runs all 12 months at the same time. Any advice would be greatly appreciated.
Thanks


"
Sub DoItAll1()
'
' DoItAll Macro
' Macro recorded 10/13/2006
'

Application.ScreenUpdating = False
Range("A1").Select
Sheets("ledger").Select
Range("A1:B1750").Select
Selection.Copy
Sheets("P1").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A1").Select
Sheets("1st sort").Select
Range("A11750").Select
ActiveWindow.SmallScroll Down:=-18
Application.CutCopyMode = False
Selection.Copy
Sheets("P1").Select
Range("C1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Dim i As Integer

i = 1

While Cells(i, 6) <> ""
Cells(i, 6).Select
If Cells(i, 6) = 0 Then
Rows(i).Delete
Else
i = i + 1
End If
Range("F1").Select
Wend

Range("A1:F1750").Select
Application.CutCopyMode = False
Selection.Copy
End Sub
"


And the Main code




"
Sub RunAll()
DoItAll1
DoItAll2
DoItAll3
DoItAll4
DoItAll5
DoItAll6
DoItAll7
DoItAll8
DoItAll9
DoItAll10
DoItAll11
DoItAll12
End Sub

 

[HughLerwill]

You should avoid use of Select and Selection where ever possible e.g. your;

Sheets("ledger").Select
Range("A1:B1750").Select
Selection.Copy

can be shortened to;

Sheets("ledger").Range("A1:B1750").Selection.Copy

You should be able to get rid of most if not all the Selects. That done it should be a bit faster and you can concentrate on further optimization.

Regards Hugh

 

[Loomah]

hi
first thing to beaar in mind is that you really don't need to select ranges all the time. for some pointers have a look in the faq section for SkipVought's faq on making code run faster (can't remember the exact title!)

the next thing is that you can speed up copy/past routines by using this syntax

myCopyRange.copy destination:=myDestinationRange

unless you really need to paste special!

ext thing is get rid of code you don't need - you don't need code that scrolls the window!

Not too sure about the criteria you have for deleting rows so there may be another way of identifying them all in one go and deleting in one hit. Regardless of that, you should note that you should always loop bottom to top when deleting rows

ie use
for i = lastrow to firstrow step -1
rows(i).delete
next


;-)

If a man says something and there are no women there to hear him, is he still wrong?
How do I get the best answers?​

 

[Loomah]

hi again
this is the afore mentioned faq

faq707-4105


also appologies for my useless typing & speling but i'm citing planet loomah rules which makes it all correct!

;-)

If a man says something and there are no women there to hear him, is he still wrong?
How do I get the best answers?​

 

[dignityy]

Thanks Hugh I will make those changes and let you know the time difference.


Loomah,
Thanks for your suggestions as well, and yes I need to copy past special. With the delete rows function I need to delete all rows in column D that are zero, is there a better way to accomplish this?
And if I add your code
"for i = lastrow to firstrow step -1
rows(i).delete"
to my delete function how excatly do I add it, do I need to just copy and paste it in at the end of that routine or rewrite it differently.
Thanks

 

[HughLerwill]

Sorry my;

Sheets("ledger").Range("A1:B1750").Selection.Copy

should've been;

Sheets("ledger").Range("A1:B1750").Copy

Hugh,

 

[stevexff]

I'm assuming that doItAll2-12are identical apart from the ranges selected, and the target sheet? In which case, you can name the ranges in the ledger sheet and parameterise the subroutine giving you a 92.5% reduction in code bloat.

Sub doItAll(myRange As String, myTarget As String)
   Sheets("ledger").Range(myRange).Copy
   'etc...
End Sub

Sub runAll()
   For i = 1 to 12
      doItAll("month_" & i, "Sort " & i)
   Next
End Sub

Loomah's tip about deleting from bottom to top is a good one, as it eliminates the need for the If-Then-Else.



Steve

[small]"Every program can be reduced by one instruction, and every program has at least one bug. Therefore, any program can be reduced to one instruction which doesn't work." (Object:erlDesignPatterns)[/small]

 

[Loomah]

Hi
I seem to have a bit more time today!

The following give you 2 options
a uses a loop to fing zero values and delete the rows
b uses the sort method to group your zero values and delete them as a block. This should be much faster than looping but will only be of use if it's ok for you to sort your data in this way.

Jst in case it's a requirement the code should take into account negative values and ignore them, deleting only rows where the relevant value is 0.

In both cases I've ignored header rows and assumed data starts at row 1. However, both options should handle headers OK!

Sub a()
'always define row variable as type long
Dim lLastRow As Long, lRowCount As Long

With Worksheets("P1")

'code to copy data
    Worksheets("ledger").Range("A1:b1750").Copy
        .Range("a1").PasteSpecial xlPasteValues
    Worksheets("1st sort").Range("a1:d1750").Copy
        .Range("c1").PasteSpecial xlPasteValues
        
'code to delete rows
    lLastRow = .Cells(65536, 6).End(xlUp).Row
    For lRowCount = lLastRow To 1 Step -1
        If .Cells(lRowCount, 6) = 0 Then
            .Rows(lRowCount).EntireRow.Delete
        End If
    Next

End With

Application.CutCopyMode = False

End Sub

Sub b()
'always define row variable as type long
Dim lLastRow As Long, lFirstRow As Long

With Worksheets("P1")

'code to copy data
    Worksheets("ledger").Range("A1:b1750").Copy
        .Range("a1").PasteSpecial xlPasteValues
    Worksheets("1st sort").Range("a1:d1750").Copy
        .Range("c1").PasteSpecial xlPasteValues
       
'FASTER code to delete rows
    .Range("F1").Sort Key1:=Range("F1"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
    lFirstRow = .Cells.Find(0, .[f65536].End(xlUp), , xlWhole, , xlNext).Row
    lLastRow = .Cells.Find(0, , , xlWhole, , xlPrevious).Row
    .Rows(lFirstRow & ":" & lLastRow).EntireRow.Delete

End With

Application.CutCopyMode = False

End Sub

;-)

If a man says something and there are no women there to hear him, is he still wrong?
How do I get the best answers?​

 

[dignityy]

Thanks alot for the great responses, I need some time to implement them. I did however start playing around with using the filter function as an alternative to using the delete code which obviously saved tons of time.

Loomah I will try your code out today... thanks for taking the time.

 

[dignityy]

Loomah,

One quick question though, I only want the delete function to look at column "F" ($ column) for zero values? Does your code currently look at any column? The problem is that I have text columns "A" & "B", account numbers in columns "C" through "E" and $'s in column "F".

Thanks

 

[dignityy]

Loomah,
Forget my last question, your code works awesome, took the processing time from 15 minutes to 15 seconds, most impressive!
Your code works great if I run each month independently but when I run the main macro:

Sub RunAll()
DoItAll1
DoItAll2
DoItAll3
DoItAll4
DoItAll5
DoItAll6
DoItAll7
DoItAll8
DoItAll9
DoItAll10
DoItAll11
DoItAll12
End Sub

I get the following run time error "1004" - and the following code is highlighted -

.Range("F1").sort Key1:=Range("F1"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom

Thanks

 

[Loomah]

Runtime 1004 doesn't really say a lot without having the description!

What is the main difference between DoItAll1 through to DoItAll12? Are they working on the same workbook? On the same worksheets as in your original code?

Anyway, this looks, unfortuantely, like one of the situations where you might need to activate a sheet. Just add .Activate immediately prior to the line that is erroring out to see what happens.

;-)

If a man says something and there are no women there to hear him, is he still wrong?
How do I get the best answers?​

 

[dignityy]

Loomah,
Yes all the DoItAll's are working from the same workbook. Your suggestion of adding .Activate worked. We are right in the middle of uploading our budget using new software and you helped me out big time. Thanks for taking the time, very much appreciated.

Oh and actually your new code runs at 5 seconds