delete rows contains TOTAL word across sheets

[Mussala]

Hi
I have rows some of them contains TOTAL word in column A for just two sheets(sh, mn) . I want deleting the whole rows contain TOTAL word in column A for two sheets.
thanks

 

[Michael M]

Another option

Sub Mussala2()
Dim ws As Worksheet
For Each ws In Worksheets
Select Case ws.Name
    Case "sh", "mn"
     With ws.Range("A1", Cells(Rows.Count, "A").End(xlUp))
        .Replace "TOTAL", "#N/A", xlWhole, , False, , False, False
        ws.Columns("A").SpecialCells(xlConstants, xlErrors).EntireRow.Delete
    End With
End Select
Next ws
End Sub

 

[Mussala]

@kevin9999
perfect !
may you make it more fast with big data , please?

 

[kevin9999]

There is a much faster method (leave it with me) but how much bigger is the data?

 

[Mussala]

about more than 10000 rows for each sheet.

 

[shinigamilight]

Sub row_delete2()
        Dim lr As Long: lr = Range("A" & Rows.Count).End(xlUp).Row
        
        
        Range("B2:B" & lr).Formula = "=if(A2=""total"",1,"""")"
        Range("B2:b" & lr) = Range("B2:b" & lr).Value
        
        Range("A1").CurrentRegion.Sort key1:=Range("B1"), order1:=xlDescending, Header:=xlYes
        Range("b2:b" & Range("B" & Rows.Count).End(xlUp).Row).EntireRow.Delete
        
        
End Sub

 

[kevin9999]

Try the following - tested on 2 sheets of 25K rows around 0.25 seconds.

Option Explicit
Sub Mussala_V2()
    Application.Calculation = xlManual
    Application.ScreenUpdating = False
    Dim ws As Worksheet, LRow As Long, LCol As Long, i As Long, a, b
    
    For Each ws In ThisWorkbook.Worksheets
        Select Case ws.Name
            Case "sh", "mn"
            LRow = ws.Cells.Find("*", , xlFormulas, , xlByRows, xlPrevious).Row
            LCol = ws.Cells.Find("*", , xlFormulas, , xlByColumns, xlPrevious).Column + 1
            a = Range(ws.Cells(2, 1), ws.Cells(LRow, 1))
            ReDim b(1 To UBound(a), 1 To 1)
            For i = 1 To UBound(a)
                If a(i, 1) = "TOTAL" Then b(i, 1) = 1
            Next i
            ws.Cells(2, LCol).Resize(UBound(a)) = b
            i = WorksheetFunction.Sum(ws.Columns(LCol))
            If i > 0 Then
                ws.Range(ws.Cells(2, 1), ws.Cells(LRow, LCol)).Sort Key1:=ws.Cells(2, LCol), _
                order1:=xlAscending, Header:=xlNo
                ws.Cells(2, LCol).Resize(i).EntireRow.Delete
            End If
        End Select
    Next ws
    Application.Calculation = xlAutomatic
    Application.ScreenUpdating = True
End Sub

 

[Mussala]

@Michael M
thanks , it gives error method of range object_workseet failed

With ws.Range("A1", Cells(Rows.Count, "A").End(xlUp))

 

[Mussala]

@shinigamilight
thanks , your code just run for active sheet and I have two and clear date in column B!

 

[Mussala]

@kevin9999
this is really fast .
just I have new request sorry !
may you re-autonumbering in column A : 1,2.3... after delete TOTAL row for each sheet ,please ?

 

[kevin9999]

re-autonumbering in column A : 1,2.3.

See if the following gives you what you want:

Option Explicit
Sub Mussala_V3()
    Application.Calculation = xlManual
    Application.ScreenUpdating = False
    Dim ws As Worksheet, LRow As Long, LCol As Long, i As Long, a, b
    
    For Each ws In ThisWorkbook.Worksheets
        Select Case ws.Name
            Case "sh", "mn"
            LRow = ws.Cells.Find("*", , xlFormulas, , xlByRows, xlPrevious).Row
            LCol = ws.Cells.Find("*", , xlFormulas, , xlByColumns, xlPrevious).Column + 1
            a = Range(ws.Cells(2, 1), ws.Cells(LRow, 1))
            ReDim b(1 To UBound(a), 1 To 1)
            For i = 1 To UBound(a)
                If a(i, 1) = "TOTAL" Then b(i, 1) = 1
            Next i
            ws.Cells(2, LCol).Resize(UBound(a)) = b
            i = WorksheetFunction.Sum(ws.Columns(LCol))
            If i > 0 Then
                ws.Range(ws.Cells(2, 1), ws.Cells(LRow, LCol)).Sort Key1:=ws.Cells(2, LCol), _
                order1:=xlAscending, Header:=xlNo
                ws.Cells(2, LCol).Resize(i).EntireRow.Delete
            End If
            LRow = ws.Cells(Rows.Count, 1).End(xlUp).Row
            With ws.Range("A2:A" & LRow)
                .Value = Evaluate("ROW(" & .Address & ")-1")
            End With
        End Select
    Next ws
    Application.Calculation = xlAutomatic
    Application.ScreenUpdating = True
End Sub