CODEWITHSUNDEEP
excelvba
DHPA
DHPA

Reputation: 55

Deleting rows when two blank rows are concurrent

Currently I'm using the following to delete blank rows from a sheet that generally has 200 to 700 rows.

Sub DeleteBlankRows2()
Dim i As Integer
Dim lastrow As Long
Dim Emptyrow As Long

lastrow = Application.CountA(Range("a:a"))
Emptyrow = Application.CountA(ActiveCell.EntireRow)

Range("a1").Select

For i = lastrow To 1 Step -1
    If Emptyrow = 0 Then
            Cells(i, 1).EntireRow.Delete
        Else
            Cells(i, 1).Offset(1, 0).Select
        End If
   Next i

End Sub

Unfortunately I've got something wrong as the amount of rows changes each time it runs through. What I've observed is that the first loop will delete four rows and the second loops deletes two rows until there is only one row left with information in it. Not sure why it is deleting rows that have cells in column A that have information?

Upvotes: 0

Views: 96

Answers (1)

Scott Craner
Scott Craner

Reputation: 152660

  1. Emptyrow is not recalculating every loop.
  2. using COUNTA on column A with blanks is going to give you a false lastrow.

Create a range object that as you find empty rows you add the row to that range. Then delete the whole range at once.

use:

Sub DeleteBlankRows2()
Dim i As Integer
Dim rng As Range
Dim lastrow As Long
Dim Emptyrow As Long

With ActiveSheet 'better to use actual sheet name "WorkSheets("Sheet1")

    lastrow = .Cells(.Rows.Count, 1).End(xlUp).Row

    For i = lastrow To 1 Step -1
        If Application.WorksheetFunction.CountA(.Rows(i)) = 0 Then
            If rng Is Nothing Then
                Set rng = .Rows(i)
            Else
                Set rng = Union(rng, .Rows(i))
            End If
        End If
    Next i
    If Not rng Is Nothing Then rng.Delete
End With

End Sub

Upvotes: 0

Related Questions