How to select and delete a range of cells between two different ranges of unequal size?

Perhaps

With rng
    Set compactRng = Range(.Item(1), .Item(.cells.count))
End With

compactRng.ClearContents

Or you could use the two argument form of Range to collect your found cells, instead of Union.