Macro Run Time

[Viking1221]

Hello,

I have this macro that is supposed to delete rows that are blank in either column C or D, but it tends to run for a long time and I am not sure why. Any ideas on how to make it more efficient?

Sub deleteBlankRows()
Range("D10:D8000").Select
Selection.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
Range("C10:C8000").Select
Selection.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub


I also have a macro that delete row with all 0' in certain columns and it also seems to take a while to run. Not sure where I am going wrong:

Public Sub DeleteZeroRows()
Dim i As Long, lastrow As Long
lastrow = Range("D" & Rows.Count).End(xlUp).Row
For i = lastrow To 1 Step -1
If Application.Sum(Range("D" & i & ":BZ" & i)) = 0 Then
Rows(i).Delete
End If
Next i
End Sub

Thanks

 

[Logit]

.

Option Explicit


Sub deleteBlankRows()
On Error Resume Next
Range("C10:D8000").Select
Selection.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub

This macro will search Col D for cells containing a zero. Perhaps you can modify it to suit your needs of a range ?

Sub sbDelete_Rows_IF_Cell_Contains_Error()
Dim lRow As Long
Dim iCntr As Long
lRow = 8000
For iCntr = lRow To 1 Step -1
    If Cells(iCntr, 4) = 0 Then
        Rows(iCntr).Delete
    End If
Next
End Sub

 

[CalcSux78]

You could attempt turning off resources you don't need while executing code.

Dim scrn As Boolean, Estate As Boolean, calc&
With Application    'get original settings
    scrn = .ScreenUpdating
    Estate = .EnableEvents
    calc = .Calculation
    'turn it off
    .ScreenUpdating = 0
    .EnableEvents = 0
    .Calculation = -4135
End With


'****your code here****




With Application    'turn it back on
    .Calculation = calc
    .EnableEvents = Estate
    .ScreenUpdating = scrn
End With