Possible to make this macro faster?

ste33uka

Active Member
Joined
Jan 31, 2020
Messages
409
Office Version
  1. 365
Platform
  1. Windows
Hi could anyone make this macro faster for deleting rows?
The macro deletes rows if cells R to P are blank
Currently it is taking 15 minutes to do 1000 rows.
Thanks

VBA Code:
Sub DeleteRows()
Dim x As Long, LastRow As Long, cRange As Range
LastRow = ActiveSheet.Cells(Rows.Count, "D").End(xlUp).Row
Set cRange = Range("R1:P" & LastRow)
For x = cRange.Cells.Count To 1 Step -1
    With cRange.Cells(x)
        If Application.WorksheetFunction.CountIf(Range("p" & .Row & ":" & "r" & .Row), "") = 3 Then
            .EntireRow.Delete
        End If
    End With
Next x
MsgBox "Complete"
End Sub
 

ste33uka

Active Member
Joined
Jan 31, 2020
Messages
409
Office Version
  1. 365
Platform
  1. Windows
wow, thanks peter, deleted all rows in 1 second, really appreciate it,
And thanks all others for suggestions
 

Excel Facts

Bring active cell back into view
Start at A1 and select to A9999 while writing a formula, you can't see A1 anymore. Press Ctrl+Backspace to bring active cell into view.

Macropod

Retired Moderator
Joined
Aug 27, 2007
Messages
3,567
thanks but still takes over 15 minutes
It takes less than a second on my laptop. Evidently you have lots of recalculation going on. In that case, insert:
Application.Calculation = xlCalculationManual
after:
Application.ScreenUpdating = False
and insert:
Application.Calculation = xlCalculationAutomatic
before:
Application.ScreenUpdating = True
 

Alex Blakenburg

Well-known Member
Joined
Feb 23, 2021
Messages
1,068
Office Version
  1. 365
Platform
  1. Windows
@Peter_SSs loved your solution so I took some time working through it.
If there were a lot of formulas on the rows and based on the principle it faster to delete from the bottom, would it have run faster if:-
After the For i = 1 To UBound(a) we added
VBA Code:
b(i, 1) = 0

The sort in the delete section would then have sorted the rows to delete to the bottom.

And then for the delete swapped .Resize(k).EntireRow.Delete for
VBA Code:
.Offset(lr - k).Resize(k).EntireRow.Delete
 

Peter_SSs

MrExcel MVP, Moderator
Joined
May 28, 2005
Messages
49,397
Office Version
  1. 365
Platform
  1. Windows
Hi Alex

In any testing that I have done in the past with variations of this code I have found no discernible difference in deleting from top or bottom, the speed is gained from deleting one contiguous block instead of multiple disjoint blocks.
It would be miniscule in time but your suggestion would need one extra step too - to remove all the remaining zeros from the last column. :)
 

Alex Blakenburg

Well-known Member
Joined
Feb 23, 2021
Messages
1,068
Office Version
  1. 365
Platform
  1. Windows
Hi Alex

In any testing that I have done in the past with variations of this code I have found no discernible difference in deleting from top or bottom, the speed is gained from deleting one contiguous block instead of multiple disjoint blocks.
It would be miniscule in time but your suggestion would need one extra step too - to remove all the remaining zeros from the last column. :)

True. I have had issues in the past where the spreadsheet had lots of lookup and even the sort was slow. I thought the order might matter if you had a lot of look ups but armed with your advice I just tried it on a 3.5k row spreadsheet with lots of columns with formulas which of course confirmed your test results that sorting the rows for deletion to the top or the bottom made very little difference.

I have tucked your code away for future use. Thank you.
 

Forum statistics

Threads
1,136,206
Messages
5,674,404
Members
419,506
Latest member
mpazr001

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
Top