Delete rows with merged cells

Question

I found a procedure to highlight merged cells in an active sheet:

I tried a ActiveCell.EntireRow.Delete statement to delete the row that is currently iterated over.

Sub DeleteRows()
    Dim x As Range
    For Each x In ActiveSheet.UsedRange
        If x.MergeCells Then
            x.Interior.ColorIndex = 8
            ActiveCell.EntireRow.Delete
        End If
    Next
End Sub

I don't care about highlighting the merged cells. The goal is to delete any row that has a merged cell.

Answer 1

Find out all merged cell ranges, club them and delete in one go.

---

Sub DeleteRows()
    Dim x As Range
    Dim rngDelete As Range
    For Each x In ActiveSheet.UsedRange
        If x.MergeCells Then
            If rngDelete Is Nothing Then
                Set rngDelete = x
            Else
                Set rngDelete = Union(rngDelete, x)
            End If
        End If
    Next
    If Not rngDelete Is Nothing Then
        rngDelete.EntireRow.Delete
    End If
End Sub

Answer 2

When deleting rows, always delete from the bottom up or a) you risk deleting the next cell you want to examine and b) you risk skipping over a row that comes up to take the place of a deleted row.

Sub DeleteRows()
    Dim r as long, c as long

    with ActiveSheet.UsedRange
        'work backwards through the rows
        For r = .rows.count to 1 step -1
            'work forwards through the columns
            For c = 1 to .columns.count
                If .cells(r, c).MergeCells Then
                    'once a merged cell is found, delete then go immediately to the next row
                    .cells(r, c).EntireRow.Delete
                    exit for
                End If
            next c
        Next r
    end with

End Sub

Answer 3

A quick way to do this is to find all the merged cells then delete them in one go: a good way to do this is to use a range.find using a cells 'format' as merged then combine the found ranges

The following code loops through merged ranges and creates a union then selects the entire rows

Sub SelectMerge()
    Dim rng As Range, rngUnion As Range, Test As Range
    Dim ws As Worksheet: Set ws = ActiveSheet

    With Application.FindFormat
        .Clear
        .MergeCells = True
    End With

    With ws.UsedRange
        Set rng = .Find("", SearchFormat:=True)
        Do
            If Not rngUnion Is Nothing Then Set rngUnion = Application.Union(rng, rngUnion)
            If rngUnion Is Nothing Then Set rngUnion = rng
            If rng Is Nothing Then Exit Do
            Set rng = .Find("", After:=rng, SearchFormat:=True)
        Loop While Application.Intersect(rng, rngUnion) Is Nothing
    End With
    If Not rngUnion Is Nothing Then rngUnion.EntireRow.Select 'rngUnion.EntireRow.Delete

End Sub