My Row delete code is soooooo slow......... need cleanup and/or modification please

[Javi]

Hi All,

The two codes below delete each EntireRow that has "Function carried out" in column I of its row. However, the sheet I am using this code on has approximately 40,000 lines occupied. Code 1 is a little faster than Code 2 but both of them are so slow there almost unusable.

Any help or assistance in speeding up this would be greatly appreciated.



Code 1

Sub SelRows_After1()
    Dim ocell As Range
    Dim rng As Range
    
    For Each ocell In Range("I3:I40000")
        
        If ocell.Value = "Function carried out" Then
            
            If rng Is Nothing Then
                
                Set rng = ocell.EntireRow
            Else
                
                Set rng = Union(rng, ocell.EntireRow)
            End If
        End If
    Next
    
     
    If Not rng Is Nothing Then rng.Delete
    
    Set rng = Nothing
    Set ocell = Nothing
End Sub

Code 2

Sub DelRow_FCO()




Application.Calculation = xlCalculationManual
Application.EnableEvents = False
Application.ScreenUpdating = False




Dim DeleteRow As Long
Dim ws As Worksheet




Set ws = ActiveSheet


For DeleteRow = ws.Range("I" & Rows.Count).End(xlUp).Row To 3 Step -1


If ws.Range("I" & DeleteRow).Value = "Function carried out" Then
    Rows(DeleteRow).EntireRow.Delete
    End If
    
Next DeleteRow




Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
Application.ScreenUpdating = True




End Sub

 

[Fluff]

How does that value get in col I, is it by formula, or some other method?

 

[Javi]

Exported from other program, no Formula is cells.

 

[Norie]

Turning off screen updating and automatic calculation might help.

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

' your code.

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
[/code

You might also consider using a filter so only the rows with 'Function carried out' are visible and then using SpecialCells to delete the visible rows.

 

[Fluff]

Exported from other program, no Formula is cells.

In that case 2 options

Sub FilterDelete()

   Dim Usdrws As Long
Application.ScreenUpdating = False
   Usdrws = Range("I" & Rows.Count).End(xlUp).Row
   Range("A2:I2").AutoFilter 9, "Function carried out"
   Range("A3:A" & Usdrws).SpecialCells(xlVisible).EntireRow.Delete
   Range("A2:I2").AutoFilter
   
End Sub

Sub ReplaceDelete()

Application.ScreenUpdating = False

   With Range("I3", Range("I" & Rows.Count).End(xlUp))
      .Replace "Function carried out", "#N/A", xlWhole, , False, , False, False
      .SpecialCells(xlConstants, xlErrors).EntireRow.Delete
   End With
End Sub

 

[Eric W]

If you don't have any errors in that column, you can try:

Sub DeleteLines()

    Range("I:I").Replace "Function carried out", "#N/A"
    Range("I:I").SpecialCells(xlConstants, xlErrors).EntireRow.Delete
   
End Sub

Should be very fast.

 

[Javi]

Thank you Norie, Fluff and Eric,

The below code is the fastest of the (3) option offered and somewhat faster then the original but still very very slow.

Any other ideas out there?

Sub DelRow_FCO_4()


Application.Calculation = xlCalculationManual
Application.EnableEvents = False
Application.ScreenUpdating = False


    Range("I:I").Replace "Function carried out", "#N/A"
    Range("I:I").SpecialCells(xlConstants, xlErrors).EntireRow.Delete
   
   


Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
Application.ScreenUpdating = True


End Sub

 

[Fluff]

You could speed that up if you sort the data based on col I first.

 

[Javi]

I do have a sort code I am running first before the delete row code.

 

[Fluff]

How slow is slow?

I've just both the codes I supplied on 20,000 rows deleting 3100 rows & both took under 1.5 seconds