Sub deleteRows() With ActiveSheet cntC = .Cells(1, Columns.Count).End(xlToLeft).Column For col = cntC To 1 Step -1 cntR = .Cells(Rows.Count, col).End(xlUp).Row For Row = cntR To 2 Step -1 If .Cells(Row, col) = "" And .Cells(Row - 1, col) =…