simple code optimization

NicholasP

Active Member
Joined
Nov 18, 2006
Messages
291
I have a macro that takes ~22 seconds to run and ~18 of those seconds are in this piece of code:

Code:
For A = x To Z Step -1
    If Cells(A, 3) = "" And Cells(A, 4) = "" And Cells(A, 5) = "" And Cells(A, 6) = "" And Cells(A, 7) = "" And Cells(A, 8) = "" And Cells(A, 9) = "" And Cells(A, 10) = "" And Cells(A, 11) = "" And Cells(A, 12) = "" And Cells(A, 13) = "" And Cells(A, 14) = "" Then
        If Cells(A, 2) <> "" And Cells(A, 1) <> "" And Cells(A, 2) <> "M" And Cells(A, 1) <> "ABCD" And Cells(A, 2) <> "I" And Cells(A, 1) <> "IPR" And Cells(A, 1) <> "Total" Then
            Cells(A, 3).EntireRow.Delete Shift:=xlUp
        End If
    End If
Next

This is a pretty small file and I tried deleting all the rows beneath the used area (<200 used rows) as well as unused columns, thinking there may have been some formatting that was forcing Excel to slow down.

I also tried setting calculations to xlmanual, though that only saved ~3 seconds on the overall macro. Specifically, the code really bogs down when a row is deleted. I tried only deleting the necessary cells, but that actually made the code run slower. I'm out of ideas here and any help would be greatly appreciated.

Thanks
Nick
 
Last edited:

Excel Facts

Get help while writing formula
Click the italics "fx" icon to the left of the formula bar to open the Functions Arguments dialog. Help is displayed for each argument.
I also tried setting calculations to xlmanual
Also turn off ScreenUpdating while it is running.
 
Upvote 0
Try deleting all the rows in one go like
Code:
Dim Rng As Range
For a = x To z Step -1
    If Cells(a, 3) = "" And Cells(a, 4) = "" And Cells(a, 5) = "" And Cells(a, 6) = "" And Cells(a, 7) = "" And Cells(a, 8) = "" And Cells(a, 9) = "" And Cells(a, 10) = "" And Cells(a, 11) = "" And Cells(a, 12) = "" And Cells(a, 13) = "" And Cells(a, 14) = "" Then
        If Cells(a, 2) <> "" And Cells(a, 1) <> "" And Cells(a, 2) <> "M" And Cells(a, 1) <> "ABCD" And Cells(a, 2) <> "I" And Cells(a, 1) <> "IPR" And Cells(a, 1) <> "Total" Then
            If Rng Is Nothing Then Set Rng = Rows(a) Else Set Rng = Union(Rng, Rows(a))
        End If
    End If
Next
If Not Rng Is Nothing Then Rng.Delete
 
Upvote 0
I did turn off screen updating as well, I forgot to mention that. I will try deleting all the rows in a single shot. There are multiple sections, so I will have to see how it works.
 
Upvote 0
another cause of your slow speed is that you are accessing the worksheet about 20 times in every loop ,all but one of them is not needed, if you load all the data into a variant array before starting the loop . try this:
Code:
'load all the input data into a varianmt array
inarr = Range(Cells(1, 1), Cells(x, 14))


For A = x To Z Step -1
    If inarr(A, 3) = "" And inarr(A, 4) = "" And inarr(A, 5) = "" And inarr(A, 6) = "" And inarr(A, 7) = "" And inarr(A, 8) = "" And inarr(A, 9) = "" And inarr(A, 10) = "" And inarr(A, 11) = "" And inarr(A, 12) = "" And inarr(A, 13) = "" And inarr(A, 14) = "" Then
        If inarr(A, 2) <> "" And inarr(A, 1) <> "" And inarr(A, 2) <> "M" And inarr(A, 1) <> "ABCD" And inarr(A, 2) <> "I" And inarr(A, 1) <> "IPR" And inarr(A, 1) <> "Total" Then
            Cells(A, 3).EntireRow.Delete Shift:=xlUp
        End If
    End If
Next

This code can then be combined with Fluff's modification to delete all the rows at once.
 
Last edited:
Upvote 0
I incorporated Fluff's changes and got the macro down to about 4 seconds. I'm not exactly sure how to combine Offthelip's suggestion with Fluff's suggestion. Would I just swap out
Code:
 Cells(A, 3).EntireRow.Delete Shift:=xlUp

with
Code:
 If Rng Is Nothing Then Set Rng = Rows(A) Else Set Rng = Union(Rng, Rows(A))
?
 
Upvote 0
Yes that is it more or less, this is what i think you need:
Code:
Sub test()
Dim rng As Range


'load all the input data into a varianmt array
inarr = Range(Cells(1, 1), Cells(x, 14))




For a = x To Z Step -1
    If inarr(a, 3) = "" And inarr(a, 4) = "" And inarr(a, 5) = "" And inarr(a, 6) = "" And inarr(a, 7) = "" And inarr(a, 8) = "" And inarr(a, 9) = "" And inarr(a, 10) = "" And inarr(a, 11) = "" And inarr(a, 12) = "" And inarr(a, 13) = "" And inarr(a, 14) = "" Then
        If inarr(a, 2) <> "" And inarr(a, 1) <> "" And inarr(a, 2) <> "M" And inarr(a, 1) <> "ABCD" And inarr(a, 2) <> "I" And inarr(a, 1) <> "IPR" And inarr(a, 1) <> "Total" Then
            If rng Is Nothing Then Set rng = Rows(a) Else Set rng = Union(rng, Rows(a))
        End If
    End If
Next
If Not rng Is Nothing Then rng.Delete
End Sub
 
Upvote 0

Forum statistics

Threads
1,213,544
Messages
6,114,249
Members
448,556
Latest member
peterhess2002

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top