Delete entire row contains SUM words for each sheet contains 8000 rows

[Maklil]

Hi
I search for macro to deal with big data(more than 8000 rows for each sheet) increasing With the passage of time. should search for SUM words in column A for each sheet ,then just delete multiple entires rows contain SUM words at once for each sheet .
there are some sheets doesn't contain SUM words so should ignore it.
thanks

 

[mumps]

Try:

Sub DeleteRows()
    Application.ScreenUpdating = False
    Dim ws As Worksheet
    On Error Resume Next
    For Each ws In Sheets
        With ws
            .Columns("A").Replace "SUM", "#N/A", xlWhole, , False
            .Columns("A").SpecialCells(xlConstants, xlErrors).EntireRow.Delete
        End With
    Next ws
    On Error GoTo 0
    Application.ScreenUpdating = True
End Sub

 

[Maklil]

Hi,
works, but is really slow.
could you re-produce it to make fast,please?

 

[Joe4]

See if this speeds it up at all:

Sub DeleteRows()

    Application.EnableEvents = False
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    Dim ws As Worksheet
    On Error Resume Next
    For Each ws In Sheets
        With ws
            .Columns("A").Replace "SUM", "#N/A", xlWhole, , False
            .Columns("A").SpecialCells(xlConstants, xlErrors).EntireRow.Delete
        End With
    Next ws
    On Error GoTo 0
    
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    
End Sub

 

[Maklil]

Thanks Joe.
it's too much slow than Mumps' code!

 

[Joe4]

It should definitely NOT be any slower than mumps code, as it is just mumps code with a few commands in there that would only speed up the code, never slow it done (as it suppresses event code from running and calculations while the code is running). This are things people usually do to speed up their code.

If your code is slower, I suspect you have something else interfering with it.

 

[Maklil]

If your code is slower, I suspect you have something else interfering with it.

not sure what you mean , but I made sure there is no others codes!

 

[Fuji]

See if this is faster,

Sub test()
    Dim ws As Worksheet, x
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    For Each ws In Worksheets
        ws.Columns(1).Insert
        With ws.Range("b1", ws.Range("b" & Rows.Count).End(xlUp)).Columns(0)
            .Formula = "=if(isnumber(search(""sum"",b1)),""z"","""")&row()"
            .Value = .Value
            .EntireRow.Sort .Cells(1), 1
            x = Application.Match("z*", .Cells, 0)
            If IsNumeric(x) Then ws.Rows(x & ":" & .Rows.Count).Delete
        End With
        ws.Columns(1).Delete
    Next
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
End Sub

 

[Maklil]

thanks Fuji.
this is really better .
may you guide me how autonumbering in column A like 1,2,..... after Deletion,please?

 

[Fuji]

Sub test()
    Dim ws As Worksheet, x
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    For Each ws In Worksheets
        ws.Columns(1).Insert
        With ws.Range("b1", ws.Range("b" & Rows.Count).End(xlUp)).Columns(0)
            .Formula = "=if(isnumber(search(""sum"",b1)),""z"","""")&row()"
            .Value = .Value
            .EntireRow.Sort .Cells(1), 1
            x = Application.Match("z*", .Cells, 0)
            If IsNumeric(x) Then ws.Rows(x & ":" & .Rows.Count).Clear
        End With
        ws.Columns(1).Delete
        With ws.[a1].CurrentRegion
            .Offset(1).Resize(.Rows.Count - 1).Columns(1) = Evaluate("row(1:" & .Rows.Count & ")")
        End With
    Next
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
End Sub