Slow delete loop

[Nihonjin]

Hi Experts,

My loop deletes all rows, which do have the word table in the first column. However, this is extremely slow for worksheets with over 10000 rows.

Does anybody has a faster coding idea?

j = 1
While Sheets(m).Cells(j, 1) <> ""
If Sheets(m).Cells(j, 1) = "table" Then
Rows(j & ":" & j).Select
Selection.Delete Shift:=xlUp
j = j - 1
End If
j = j + 1
Wend

Regards,

 

[jindon]

Less access to the object faster the process

Sub test()
Dim i As Long, txt As String
again:
For Each r In Range("a1", Range("a65536").End(xlUp)).SpecialCells(xlCellTypeConstants)
    If r = "Table" Then txt = txt & r.Row & ":" & r.Row & ","
    If Len(txt) > 240 Then
        txt = Left(txt, Len(txt) - 1)
        Range(txt).Delete: txt = Empty: GoTo again
    End If
Next
If Len(txt) > 0 Then
    txt = Left(txt, Len(txt) - 1)
    Range(txt).Delete
End If
End Sub

 

[Richie(UK)]

Hi N,

OK, as regards generally speeding-up code its worth remembering that the 2 main culprits for making code slow are often calculation and screenupdating. Therefore, you could try switching them off at the start of the routine and then reset again at the end.

Like this:

Sub Faster()
    Dim lCalc As Long
    
    With Application
        lCalc = .Calculation
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
    End With
    
    '
    'do slow stuff here
    '
    
    With Application
        .Calculation = lCalc
        .ScreenUpdating = True
    End With
    
End Sub

That said, the very act of looping can be a major cause of delay - you have to check all of the rows to check whether the condition is satisfied. There are alternatives such as using Find or the AutoFilter - have a Search as this has been covered many times before.

HTH

 

[Nihonjin]

Thanks Jindon & Richie,

geee, yes, this has been covered over and over. Thanks for the hint. I went with this solution:

Sub del_table()

Dim EvalRange As Range

Set EvalRange = Range("A1:A" & Range("A65536").End(xlUp).Row)
EvalRange.AutoFilter Field:=38, Criteria1:="table"
EvalRange.Offset(1).Resize(EvalRange.Rows.Count - 1).SpecialCells(xlCellTypeVisible).EntireRow.Delete
EvalRange.AutoFilter

End Sub

Regards,