simple code optimization

NicholasP

Active Member
Joined
Nov 18, 2006
Messages
289
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:

Some videos you may like

Excel Facts

Round to nearest half hour?
Use =MROUND(A2,"0:30") to round to nearest half hour. Use =CEILING(A2,"0:30") to round to next half hour.

Joe4

MrExcel MVP, Junior Admin
Joined
Aug 1, 2002
Messages
53,410
Office Version
365
Platform
Windows
I also tried setting calculations to xlmanual
Also turn off ScreenUpdating while it is running.
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
40,606
Office Version
365
Platform
Windows
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
 

NicholasP

Active Member
Joined
Nov 18, 2006
Messages
289
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.
 

offthelip

Well-known Member
Joined
Dec 23, 2017
Messages
1,234
Office Version
2010
Platform
Windows
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:

NicholasP

Active Member
Joined
Nov 18, 2006
Messages
289
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))
?
 

offthelip

Well-known Member
Joined
Dec 23, 2017
Messages
1,234
Office Version
2010
Platform
Windows
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
 

Watch MrExcel Video

Forum statistics

Threads
1,099,005
Messages
5,465,959
Members
406,456
Latest member
jmishra91

This Week's Hot Topics

Top