Select 3 rows based on criteria then remove entire rows, find next, repeat down to last row. one code line causes Run-time error '1004'

Question

Using Excel 2019 VBA

In the current workbook in a worksheet called "Test" there are two ways that data is presented vertically down the sheet.

The sheets range in size from 1000 rows to some with 8000 rows and more. Each set or group of rows that relate to each other are seperated by a blank row. One set of data, (that I need to keep) is always in 8 - 15 rows. The other set, that I want to delete the whole actual rows for is always in 3 rows with the text in Row A always the same for each set.

Row A is essentially a verticle header with a blank row inbetween each set of related data and I am trying to use the text in Colum A to select the three rows and delete the entire rows.

My logic for the code is: Look down Column A and select the first cell with the value or text "Complete name". Then count up the column 2 rows and if that row is blank, remember that row. Next count down 4 rows if that row is blank, select the rows inbetween and delete entire rows. Then move on to the next value or text "Complete name" and repeat the steps above.

I am using the count rows method as the the text "Complete name" also appears in the group or set of rows (the ones with 8 - 15 associated rows) that I want to keep so in order for the VBA to be able to the two sets or groups apart the count row method seems a good option.

I have tried many variations in the code but I can not nail it as it keep getting Run-time error '1004': Application-defined or object-defined error caused by the row If i - 4 >= 1 And ws.Cells(i - 4, 1).Value = """" Then and when using 2 x double quotes If i - 4 >= 1 And ws.Cells(i - 4, 1).Value = "" Then

This is my code. I have added comments to explain what the code is doing.

    Dim ws As Worksheet
    Dim lastRow As Long
    Dim i As Long
    Dim cell As Range
    Dim blankRow As Boolean
    
    ' Sets the reference to "Test" worksheet
    Set ws = ThisWorkbook.Sheets("Test")
    
    ' Count up and find last used row in Column A
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    
    'Look for the first cell with "Complete name and then count up 2 rows and check if row is blank"
    For i = 1 To lastRow
        ' Check if cell contains "Complete name"
        If InStr(1, ws.Cells(i, 1).Value, "Complete name", vbTextCompare) > 0 Then
            ' Count up 2 rows
            If i + 2 <= lastRow Then
                Set cell = ws.Cells(i + 2, 1)
                ' Check if selected cell is blank
                If cell.Value = "" Then
                    ' Remember cell address
                    Dim cellAddress As String
                    cellAddress = cell.Address
                    blankRow = True
                End If
            End If
            
            ' Count down 4 rows and if cell is blank, remove rows in-between the two blank rows
            If blankRow Then
                If i - 4 >= 1 And ws.Cells(i - 4, 1).Value = """" Then
                    ws.Rows(i - 4 & ":" & i + 2).EntireRow.Delete
                    blankRow = False
                    i = i - 4
                    lastRow = lastRow - 3
                End If
            End If
        End If
    Next i
End Sub```

Answer 1

• Collect all desired cells/rows as a Range object, del rows all at once.

Microsoft documentation:

Range.End property (Excel)

Range.EntireRow property (Excel)

Range.Resize property (Excel)

Option Explicit

Sub RemoveRows()
    Dim ws As Worksheet
    Dim lastRow As Long
    ' Sets the reference to "Test" worksheet
    Set ws = ThisWorkbook.Sheets("Test")
    ' Count up and find last used row in Column A
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    ' load data into an arry
    Dim arrData: arrData = ws.Range("A1:A" & lastRow).Value
    Dim i As Long, j As Long, rDel As Range
    ' loop through data row
    For i = LBound(arrData) + 4 To UBound(arrData) - 2
        ' get the Complete cells
        If InStr(1, arrData(i, 1), "Complete name", vbTextCompare) > 0 Then
            ' validate up and down cells
            If Len(arrData(i - 4, 1)) = 0 And Len(arrData(i + 2, 1)) = 0 Then
                ' collect the desired cells
                If rDel Is Nothing Then
                    Set rDel = ws.Cells(i - 4, 1).Resize(7, 1)
                Else
                    Set rDel = Union(rDel, ws.Cells(i - 4, 1).Resize(7, 1))
                End If
            End If
        End If
    Next
    ' del rows
    If Not rDel Is Nothing Then
        rDel.EntireRow.Delete
    End If
End Sub