# simple code optimization

#### NicholasP

##### Active Member
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

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

I also tried setting calculations to xlmanual
Also turn off ScreenUpdating while it is running.

#### Fluff

##### MrExcel MVP, Moderator
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
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
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
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
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``````