当前两个单元格为空白时，从列范围中删除所有行

Question

Im looking for a way to delete all rows if the first two cells in column M (Range specified starting from M6) below a sub total is blank (In this case starting from 392 until 425 has to be deleted). Second Screenshot is expected result.

Previously it works but now it deletes everything and leaves just the top 5 rows of the range.

Take note that for example - Row 1.1 in this screenshot is only 2 rows (merged) consisting of 5 rows each in actual.

My template consists of 3 rows (merged each consisting of 5 rows each) per section and ending with a row called "Sub total". So total of 17 rows per section. Each section when data is entered can consist of 2 rows (merged means 10 rows in total) + 1 row "Sub Total" or 1 or 3 with "Sub Total" in the end of that section. Bottom of the sheet 3 rows are to be kept there (Total, Submitted Invoices total, Difference) and can somehow be used as a reference for the blank rows which are in between.

Option Explicit

Sub DeleteRows()

Const Col As String = "M"
Const fRow As Long = 13
Const mcCount As Long = 5

Dim ws As Worksheet: Set ws = ActiveSheet ' improve!
Dim lRow As Long: lRow = ws.Cells(ws.Rows.Count, Col).End(xlUp).Row

Dim cCell As Range
Dim r As Long

For r = fRow To lRow - mcCount
    'Debug.Print r
    Set cCell = ws.Cells(r, Col)
    If cCell.MergeArea.Cells.Count = mcCount Then
        If Len(CStr(cCell.Value)) = 0 Then
            cCell.Offset(-1).Resize(lRow - r + 1).EntireRow.Delete
            Exit For
        End If
        r = r + mcCount - 1
    End If
Next r

MsgBox "Rows deleted.", vbInformation

End Sub

Answer 1

I don't think your code is doing what you think it is doing.

a) I wouldn't search column M for the last row; use a column that you know will be populated. b) I would start the loop at row 6. c) Your code isn't checking the "first two cells in column M"; I'm not sure what you mean by that, but you're only checking the first cell in M.

I think you'd be far better searching for that integer Item No. as the start of a section and 'Sub Total' as the end of one. You could then check each cell M in that range to see if any data is present. You don't mention whether a '0' counts as empty so you might want to test for that too.

Skeleton code would be a bit like this:

Option Explicit

Public Sub RunMe()
    Dim ws As Worksheet
    Dim rngToCheck As Range, rowToCheck As Range
    Dim startRow As Range
    Dim delRanges As Range
    Dim hasValues As Boolean
    
    'Find the data range - note we're starting from row 6.
    'I'm having to use UsedRange as I don't know what your whole sheet looks like.
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    With ws
        Set rngToCheck = .Range(.Cells(6, "A"), .UsedRange.Cells(.UsedRange.Cells.Count))
    End With
    
    For Each rowToCheck In rngToCheck.Rows
        If IsInteger(rowToCheck.Cells(1, "B").Value) Then 'it's the start of a section.
            Set startRow = rowToCheck
        ElseIf Not startRow Is Nothing Then 'we're in a section.
            If rowToCheck.Cells(1, "C") <> "Sub Total" Then 'it's a target data row.
                If Not IsEmpty(rowToCheck.Cells(1, "M").Value) Then
                    hasValues = True
                End If
            Else ' it's the end of a section.
                If Not hasValues Then 'store the section range in the delete range object.
                    Set delRanges = SafeUnion(delRanges, ws.Range(startRow, rowToCheck))
                End If
                'Reset the flags for a new section.
                Set startRow = Nothing
                hasValues = False
            End If
        End If
    Next
    
    'Delete the ranges.
    'Note that this is irreversible, so I've put a break point in for your testing.
    If Not delRanges Is Nothing Then
        'Remove this line if you're happy.
        delRanges.Worksheet.Activate: delRanges.Select: Stop
        delRanges.EntireRow.Delete
    End If
End Sub

Private Function IsInteger(val As Variant) As Boolean
    If IsEmpty(val) Then Exit Function
    If Not IsNumeric(val) Then Exit Function
    If CLng(val) <> val Then Exit Function
    IsInteger = True
    
End Function

Private Function SafeUnion(rng1 As Range, rng2 As Range) As Range
    If rng1 Is Nothing Then
        Set SafeUnion = rng2
    Else
        Set SafeUnion = Application.Union(rng1, rng2)
    End If
End Function