Macro to delete all rows below Specific Text

[athermian]

Hi,

I am using Office 2016. I have got this macro from extended office website it works very nicely and deletes all rows before "Header Details".

How can this be modified for two more deletion scenarios?

1. All rows below Header Details
2. Delete all rows below Header Details starting from row 11

Any help or suggestions would be greatly appreciated.

Thanks,

Ather

Sub DeleteRowsABove()
'UpdatebyExtendoffice20161109
    Dim fRg As Range
     
    Set fRg = Cells.Find(what:="Header Details", lookat:=xlWhole)
     
    If Not fRg Is Nothing Then
        If fRg.Row <> 1 Then
            Range("A1", fRg.Offset(-1)).EntireRow.Delete
        Else
            'MsgBox "Total Group is in the first row already", vbInformation, "Kutools for Excel"
        End If
    Else
       'MsgBox "Do not find Total Group", vbInformation, "Kutools for Excel"
    End If
     
End Sub

 

[ManiacB]

Here you go, two macro for the two conditions

'1.All rows below Header Details
Sub DeleteRowsBelow()

    Dim fRg As Range
    Dim lr, i As Long
    lr = Cells(Rows.Count, "A").End(xlUp).Row 'Assumes rowdata existsin column A
    Set fRg = Cells.Find(what:="Header Details", lookat:=xlWhole)
    For i = lr To (fRg.Row + 1) Step -1
        Cells(i, 1).EntireRow.Delete
    Next i
     
End Sub

'2. Delete all rows below Header Details starting from row 11

Sub DeleteRowsBelow11()

    Dim fRg As Range
    Dim lr, i As Long
    lr = Cells(Rows.Count, "A").End(xlUp).Row 'Assumes rowdata existsin column A
    For i = lr To 11 Step -1
        Cells(i, 1).EntireRow.Delete
    Next i
     
End Sub

 

[Rick Rothstein]

@ManiacB,

Instead of looping, why not just delete the rows all at once?

In your first macro, replace the For..Next loop with this...

Range(fRg, Cells(lr, "A")).EntireRow.Delete

In your second macro, replace the For..Next loop with this...

Range("A11", Cells(lr, "A")).EntireRow.Delete

 

[athermian]

Here you go, two macro for the two conditions

'1.All rows below Header Details
Sub DeleteRowsBelow()

    Dim fRg As Range
    Dim lr, i As Long
    lr = Cells(Rows.Count, "A").End(xlUp).Row 'Assumes rowdata existsin column A
    Set fRg = Cells.Find(what:="Header Details", lookat:=xlWhole)
    For i = lr To (fRg.Row + 1) Step -1
        Cells(i, 1).EntireRow.Delete
    Next i
    
End Sub

'2. Delete all rows below Header Details starting from row 11

Sub DeleteRowsBelow11()

    Dim fRg As Range
    Dim lr, i As Long
    lr = Cells(Rows.Count, "A").End(xlUp).Row 'Assumes rowdata existsin column A
    For i = lr To 11 Step -1
        Cells(i, 1).EntireRow.Delete
    Next i
    
End Sub

Thank you ManiacB