Handling Merged Cells when Deleting Rows

Question

I'm working on writing a module to remove unwanted text from a number of worksheets within a single workbook. I've pieced together enough to remove rows that have a specific font type, and rows that are empty; however, I've hit a snag.

The worksheets have a number of merged cells. I want to delete specific rows based on key phrases. Example, if "Comments" is found anywhere in Column A delete the row. However, if comments is merged between A2:A4, text in B3:B4 remains, leaving junk in the sheets I don't want.

Is there a way to delete the merged cell, and all rows to the right of that cell, if in the value in Column A is any number of keywords I'm looking for?

Here's what I have so far...

Sub Delete_Rows_Courier()
    Dim ws As Excel.Worksheet
    Dim LastRow As Long
    Dim i As Integer

    For Each ws In Application.ThisWorkbook.Worksheets
        LastRow = ws.Cells(Rows.Count, 1).End(xlUp).Row
        i = 1
        Do While i <= LastRow
            If ws.Range("A" & i).Font.Name = "Courier New" Then
                ws.Rows(i).Delete
                i = i - 1
                LastRow = LastRow - 1
            End If
            i = i + 1
        Loop
    Next


End Sub


Sub Delete_Empty_Rows()
    Dim ws As Worksheet
    Dim wb As Workbook
    Dim i As Long

    For Each ws In Application.ThisWorkbook.Worksheets
            'Deletes the entire row within the selection if the ENTIRE row contains no data.
            'We use Long in case they have over 32,767 rows selected.

            'We turn off calculation and screenupdating to speed up the macro.
    With Application
            .Calculation = xlCalculationManual
            .ScreenUpdating = False
            'We work backwards because we are deleting rows.
            For i = ws.UsedRange.Rows.Count To 1 Step -1
            If WorksheetFunction.CountA(ws.Rows(i)) = 0 Then
            ws.Rows(i).EntireRow.Delete
            End If
            Next i

            .Calculation = xlCalculationAutomatic
            .ScreenUpdating = True
        End With
        Next ws
End Sub

Sub RunMacros()
Delete_Empty_Rows
Delete_Rows_Courier
End Sub

Tim Williams Tim Williams · Accepted Answer · 2014-11-11T19:10:19

With .Range("A" & i).Mergearea
    x = .Rows.Count     'if you need to know how many rows were deleted
    .EntireRow.Delete   'delete merged rows 
End With

Handling Merged Cells when Deleting Rows

1 Answers