Delete blank rows on range except last row-CodePudding

I have this code where i can search for the first two blank cells and place an "x" on the first cell that contains the blank. For testing purposes i have separated the the code into two command buttons. For First command button searches the blank cells and places the "x" and second command button finds the "x" and deletes the row and all other rows after it.

My problem is, i want it to delete all rows after the "x" but to leave the last row which contains the overall Total.

Here is my code from the two command buttons :

Sub findEmptyCells()

Dim lastRow As Long, i As Long
Dim firstEmptyCell As Range

lastRow = Cells(Rows.Count, 12).End(xlUp).Row 

For i = 12 To lastRow
If Cells(i, 12).Value = "" And Cells(i   1, 12).Value = "" Then
    Set firstEmptyCell = Cells(i, 12)
    Exit For
End If
Next i

MsgBox ("There are no two empty cells in a row")
Exit Sub
End If

firstEmptyCell.Value = "x"
End Sub



Sub Deleterows_Click()

Dim srchRng As Range

Set srchRng = Range("L7:L500")

Dim c As Range
For Each c In srchRng
If c.Value = "x" Then
    
Range(c, Range("L500")).EntireRow.Delete
              
    Exit For
End If
Next

End Sub

CodePudding user response：

Delete Rows Identified By Merged Cells

Option Explicit

Sub DeleteRows()
    
    Const Col As String = "L"
    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