Thread: If there are more than 2 blank adjacent rows, delete them

Hello,

I would appreciate some insight or help in getting the following pseudo code translated to VBA... I am checking all rows from ROW 1 to ROW X for blank rows. If it finds more than 2 blank rows, delete the rows until it either hits variable X or makes it 2 blank rows between data, so essentially turning this:

*Data Rows---*
*Blank Row*
*Blank Row*
*Blank Row*
*Blank Row*
*Blank Row*
*Blank Row*
*Data Rows---*
*Blank Row*
*Blank Row*
*Blank Row*
*Row X*

into this:

*Data Rows*
*Blank Row*
*Blank Row*
*Data Rows*
*Blank Row*
*Blank Row*
*Row X*

My Brain is fried right now, and I am at my witts end... I know I must have a for loop and Row X must be subtracted by 1 every time a blank row is found and removed...

Pseudo Code:

For each cell in range (Row 1 to X)
if current cell's row is empty then check if next 2 rows are empty:
if TRUE: delete row, minus X
if FALSE: go to next row
Loop

Thanks for any help, much appreciated!

Hi,

Maybe?

Option Explicit
Sub RowsDelete()
Dim lrow As Long
Dim x As Integer
Application.ScreenUpdating = False
lrow = Cells(Rows.Count, 1).End(xlUp).Row
    For x = lrow To 1 Step -1
        If Cells(x, 1).Value = vbNullString Then
            Cells(x, 1).EntireRow.Delete
        End If
    Next x
    For x = 1 To lrow
        If Cells(x, 1).Value <> vbNullString Then
            Range(Cells(x + 1, 1), Cells(x + 2, 1)).EntireRow.Insert
            x = x + 1
        End If
    Next x
Application.ScreenUpdating = True
End Sub