How to delete empty rows that have previous or subequent rows non-empty in VBA

Question

I have empty rows in my worksheet and I want to delete them in such a way that if row above is or below is not empty, I do not want to delete them. I don't want to delete them so there are at least 1 empty row below the previous filled rows.

I know how to delete empty rows in a sheet:

Worksheets("Sheet1").Columns("A:A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete

But I am not sure how to change this to implement that. Need some guidance on how to do this.

My code looks like this now:

For Each ws In Workbooks(newwb).Sheets
    If (ws.Name <> "Sheet1") And (ws.Name <> "Sheet2") And (ws.Name <> "Sheet3") Then
        'ws.Columns("A:A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
        lRow = ws.Range("A" & Rows.Count).End(xlUp).Row
        For i = 1 To lRow
            If Application.WorksheetFunction.CountA(ws.Range("A" & i & ":O" & i + 2)) = 0 Then
                If IsEmpty(rngBlanks) Then
                    Set rngBlanks = ws.Rows(i + 1)
                Else
                    Set rngBlanks = Union(rngBlanks, ws.Rows(i + 1))
                End If
            End If
        Next i
        rngBlanks.EntireRow.Delete
        Set rngBlanks = Nothing
    Else
        ws.Delete
    End If
Next

When doing, it gives me a Run-Time error '5': Invalid Procedure Call or Argument at the line Set rngBlanks = Union(rngBlanks, ws.Rows(i+1))

score 3 · Accepted Answer · edited May 23 '17 at 11:59

I know how to delete empty rows in a sheet:

No. That is an incorrect way to delete empty rows and will not work when you have multiple columns. You may want to see This. This one uses looping and Application.WorksheetFunction.CountA. Alternatively, you can use .Autofilter as well.

But I am not sure how to change this to implement that. Need some guidance on how to do this.

Use the same logic as shown in my answer in the above link.

    '~~> Loop through the rows to find which range is blank
    For i = 1 To lRow
        '~~> Checking 3 rows in one go
        If Application.WorksheetFunction.CountA(Range("A" & i & ":J" & i + 2)) = 0 Then
            If rngBlanks Is Nothing Then
                Set rngBlanks = .Rows(i + 1)
            Else
                Set rngBlanks = Union(rngBlanks, .Rows(i + 1))
            End If
        End If
    Next i

EDIT

Please Try This (Untested)

For Each ws In Workbooks(newwb).Sheets
    Select Case ws.Name
    Case "Sheet1", "Sheet2", "Sheet3"
    Case Else
        With ws
            lRow = .Range("A" & .Rows.Count).End(xlUp).Row

            For i = 1 To lRow
                If i = .Rows.Count - 1 Then Exit For

                If Application.WorksheetFunction.CountA(.Range("A" & i & ":O" & i + 2)) = 0 Then
                    If rngBlanks Is Nothing Then
                        Set rngBlanks = .Rows(i + 1)
                    Else
                        Set rngBlanks = Union(rngBlanks, .Rows(i + 1))
                    End If
                End If
            Next i

            If Not rngBlanks Is Nothing Then
                rngBlanks.Delete
                Set rngBlanks = Nothing
            End If
        End With
    End Select
Next ws

edited the question. Facing an error: Run-Time error '5': Invalid Procedure Call or Argument at the line Set rngBlanks = Union(rngBlanks, ws.Rows(i+1)). How do I solve that? — lakshmen, Apr 13 '16 at 06:28

score 2 · Answer 2 · answered Apr 13 '16 at 02:33

It seems like each Range.Areas property within the Range.SpecialCells method with xlCellTypeBlanks should discount the first and last cell and delete the rest.

Dim a As Long, r As Long, rng As Range
With Worksheets("sheet1")
    With Intersect(.Columns(1), .UsedRange)
        With .SpecialCells(xlCellTypeBlanks)
            For a = 1 To .Areas.Count
                With .Areas(a)
                    For r = 2 To .Rows.Count - 1
                        If rng Is Nothing Then
                            Set rng = .Rows(r).Cells(1, 1)
                        Else
                            Set rng = Union(rng, .Rows(r).Cells(1, 1))
                        End If
                    Next r
                End With
            Next a
        End With
    End With
End With

'test with red fill
rng.Interior.Color = vbRed
'delete these after comfortable with debugging
'rng.EntireRow.Delete

score 0 · Answer 3 · answered Apr 13 '16 at 09:23

an alternative "formula" approach

Option Explicit

Sub main()
Dim ncols As Long
Dim colRng As Range
Dim ws As Worksheet

For Each ws In Workbooks(newwb).Sheets
    Select Case ws.Name
        Case "Sheet1", "Sheet2", "Sheet3"    
        Case Else
            With ws
                Set colRng = .Columns("A:O") '<= set the columns range you want to deal with
                ncols = colRng.Columns.Count
                With .Range("A1", .Cells(.Rows.Count, 1).End(xlUp)).Resize(, ncols).Offset(, ncols).Resize(, 1)
                    .FormulaR1C1 = "=IF(RC[-1]="""",IF(COUNTBLANK(indirect(""R["" & if(row()<2,1,-1) & ""]C[-" & ncols & "]"", False):R[1]C[-1])=" & 3 * ncols & ","""",1),1)"
                    .value = .value
                    .SpecialCells(xlCellTypeBlanks).EntireRow.Delete
                    .ClearContents
                End With
            End With
     End Select
Next ws

End Sub

it uses a "helper" column juts one left of the range to process. it then delete its content before ending

How to delete empty rows that have previous or subequent rows non-empty in VBA

3 Answers3