Deleting block of rows error - sample code included

[marchantvii]

Hi all,

I have the following code below that was running fine until I came to use it this month.

I use this to search through col A on an imported spreadsheet for anything like "DATE" and delete that row and the next 7 rows below. This block repeats roughly every 24/25 rows.

I am currently getting the following error message when running:

Sub GRNI_002_DeleteHeaderRows()

    Range("A1").Select

    Dim lastRow As Long
    Dim CurrentRow As Long
    lastRow = Range("A1").End(xlDown).Row
    CurrentRow = 1

    Do While CurrentRow <= lastRow

        If Range("A" & CurrentRow).Value Like "*DATE*" Then
            Range("A" & CurrentRow).EntireRow.Delete
            Range("A" & CurrentRow).EntireRow.Delete
            Range("A" & CurrentRow).EntireRow.Delete
            Range("A" & CurrentRow).EntireRow.Delete
            Range("A" & CurrentRow).EntireRow.Delete
            Range("A" & CurrentRow).EntireRow.Delete
            Range("A" & CurrentRow).EntireRow.Delete
            Range("A" & CurrentRow).EntireRow.Delete
            lastRow = lastRow - 8
            CurrentRow = CurrentRow - 8
            End If

        ' put the pointer to the next row we want to evaluate
        CurrentRow = CurrentRow + 1

    Loop

End Sub

The data is roughly 1500 rows long.



Any help would be greatly appreciated.

 

[Peter_SSs]

I am currently getting the following error message when running:

What is the message and what line of code does it occur on?

 

[Peter_SSs]

In any case, here is another code to try with a copy of your workbook.

Sub DelHdrRws()
  Dim rFound As Range
  
  Application.ScreenUpdating = False
  Set rFound = Columns("A").Find(What:="DATE", LookAt:=xlPart, MatchCase:=True)
  Do Until rFound Is Nothing
    rFound.Resize(8).EntireRow.Delete
    Set rFound = Columns("A").Find(What:="DATE", LookAt:=xlPart, MatchCase:=True)
  Loop
  Application.ScreenUpdating = True
End Sub

 

[marchantvii]

In any case, here is another code to try with a copy of your workbook.

Sub DelHdrRws()
  Dim rFound As Range
 
  Application.ScreenUpdating = False
  Set rFound = Columns("A").Find(What:="DATE", LookAt:=xlPart, MatchCase:=True)
  Do Until rFound Is Nothing
    rFound.Resize(8).EntireRow.Delete
    Set rFound = Columns("A").Find(What:="DATE", LookAt:=xlPart, MatchCase:=True)
  Loop
  Application.ScreenUpdating = True
End Sub

Thanks Peter for your reply - your code worked a treat.

For reference, the error occured on the following line:

If Range("A" & CurrentRow).Value Like "*DATE*" Then

With the following error attached:

Run-time error '10041:

Method 'Range' of object'_Global' failed

 

[Peter_SSs]

With the following error attached:

Run-time error '10041:

Method 'Range' of object'_Global' failed

I suspect there was a 'DATE' row near the top of the worksheet so that CurrentRow = CurrentRow - 8 produced a negative value for CurrentRow so
Range("A" & CurrentRow) would not be a valid cell reference.

Thanks Peter for your reply - your code worked a treat.

You're welcome. Thanks for the confirmation.

 

[marchantvii]

I suspect there was a 'DATE' row near the top of the worksheet so that CurrentRow = CurrentRow - 8 produced a negative value for CurrentRow so
Range("A" & CurrentRow) would not be a valid cell reference.


You're welcome. Thanks for the confirmation.

Right - thanks for confirming and the speedy reply Have a great day!

 

[Peter_SSs]

No problem. And same to you.