Find and Delete Multiple Rows based on Criteria

[Lauradk50]

Hi, I've spent days trying to resolve this and would appreciate any help. Have large data range up to 20,000 rows and need to find and delete duplicate headings within the rows (heading covers 9 rows separately). My code successfully finds and deletes the first row, but not the 8 subsequent rows. Error lies in the row that contains "resize" script below. I cannot use filtering as each heading row has similar text to some content that is to be kept, and the only unique row within the heading is the one I used to search "Report Date:" criteria.

Sub LRowDeleteHeadings()
Dim Firstrow As Long
Dim LastRow As Long
Dim Lrow As Long
Dim CalcMode As Long
Dim ViewMode As Long

With Application

CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With

With ActiveSheet
'Set the first and last row to loop through
Firstrow = .UsedRange.Cells(14, 1).Row
LastRow = .UsedRange.Rows(.UsedRange.Rows.Count).Row

'Loop from Lastrow to Firstrow (bottom to top)
For Lrow = LastRow To Firstrow Step -1
'Check the values in the A column
With .Cells(Lrow, "A")
If Not IsError(.Value) Then


If Trim(.Value) = "Report Date:" Then _
.Resize(1, 9).EntireRow.Delete
End If
End With
Next Lrow
End With


With Application
.ScreenUpdating = True
.Calculation = CalcMode
End With

End Sub

[mikerickson]

If you want to delete 9 rows at a chunk this line should be changed to:
.Resize(9,1).EntireRow.Delete

[Lauradk50]

That's brilliant - thank you ever so much, it's worked perfectly now.

Kind regards
Laura :rotlaugh:

[mikerickson]

You're welcome.