simple code optimization

[NicholasP]

I have a macro that takes ~22 seconds to run and ~18 of those seconds are in this piece of 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

 

[Joe4]

I also tried setting calculations to xlmanual

Also turn off ScreenUpdating while it is running.

 

[Fluff]

Try deleting all the rows in one go like

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]

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]

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:

'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.

 

[NicholasP]

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

 Cells(A, 3).EntireRow.Delete Shift:=xlUp

with

 If Rng Is Nothing Then Set Rng = Rows(A) Else Set Rng = Union(Rng, Rows(A))

?

 

[offthelip]

Yes that is it more or less, this is what i think you need:

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