CODEWITHSUNDEEP
excelvba
henry
henry

Reputation: 85

delete rows if there are 2 consecutive empty rows

what i want to do is to delete rows if there are 2 consecutive empty rows and also to have the empty rows between the header and the first set of data row to be deleted as well.This is my original input and what i want to have is this. i have tried to find some codes here and there and come up with this code.

Sub Testing()
    Dim i As Long , lRow As Long
    Dim ws As Worksheet

    Set ws = Activesheet
    With ws
        With .Range("C:C")
            fr = .Find(what:="*", after:=.Cells(1, 1), LookIn:=xlValues).row
            If fr > 2 Then
                .Rows("2:" & fr - 1).EntireRow.Delete
            End If
        End With
        i = 1
        For i = 1 To lRow
            If IsEmpty(Cells(i, 3)) And IsEmpty(Cells(i + 1, 3)) Then
                .Rows(i).EntireRow.Delete
           End If
        Next i
    End With
End Sub

However, there are still some consecutive empty rows in the middle of the data set. I know that is because i am increasing i which will look at the next cell but i am not sure how to solve it. I am new to vba and even newer to SO posting so let me know if there is anything i am doing wrong and thank you for your help.

Upvotes: 3

Views: 732

Answers (3)

Pᴇʜ
Pᴇʜ

Reputation: 57743

The only thing you need to do is looping backwards. Instead of 

For i = 1 To lRow

do

For i = lRow To 1 Step -1

This is because looping from the bottom doesn't have any influence on the row counting of the not yet processed rows, but looping top to bottom does.

Also you can skip i = 1 right before For it doesn't have any influence since For starts with whatever i is specified as lower bound.

I think your code is just an example but just in case note that lRow is never set to a value in your code and therefore is 0.

Note that in this line 

If IsEmpty(Cells(i, 3)) And IsEmpty(Cells(i + 1, 3)) Then

your Cells objects are not referenced to the sheet of the With statement because you forgot the . in the beginning. It should be

If IsEmpty(.Cells(i, 3)) And IsEmpty(.Cells(i + 1, 3)) Then

Furthermore I highly recommend that if you use the Range.Find method 

fr = .Find(what:="*", after:=.Cells(1, 1), LookIn:=xlValues).row

that you always specify the LookAt parameter as xlWhole or xlPart (see XlLookAt). Because the the LookAt parameter has no default value (sadly) and if you don't specify it, VBA will use either xlWhole or xlPart whatever was used last by either the user interface or VBA. So you cannot know which one was used before and it will become pretty random (or your code might sometimes work and sometimes not).

Alternative (much faster) approach …

… is to keep the forward loop and collect all rows to delete in a variable RowsToDelete to delete them in the end at once. It is so much faster because every delete action takes time and in this approach you only have one delete action … versus one delete action per row in the other approach.

Dim RowsToDelete As Range
For i = 1 To lRow 'forward loop is no issue here because we just collect
    If IsEmpty(.Cells(i, 3)) And IsEmpty(.Cells(i + 1, 3)) Then
        If RowsToDelete Is Nothing Then 'first row
            Set RowsToDelete = .Rows(i).EntireRow
        Else 'append more rows with union
            Set RowsToDelete = Application.Union(RowsToDelete, .Rows(i).EntireRow)
        End If
   End If
Next i

'delete all collected rows (after the loop, so delete doesn't affect row counting of the loop)
If Not RowsToDelete Is Nothing Then
    RowsToDelete.Delete
End If

Upvotes: 3

adhy wijaya
adhy wijaya

Reputation: 509

I think you need to decrease i after deleting a row.

For i = 1 To lRow
    If IsEmpty(Cells(i, 3)) And IsEmpty(Cells(i + 1, 3)) Then
       .Rows(i).EntireRow.Delete
       i = i - 1
       lRow = lRow - 1
    End If
   If i > lRow Then Exit For
Next i

Upvotes: 1

user12472983
user12472983

Reputation: 1

Dim blankCtr As Integer
blankCtr = 0

With ActiveSheet
For i = .Range("A" & Rows.Count).End(xlUp).Row To 2 Step -1
  If Application.WorksheetFunction.CountA(Rows(i)) = 0 Then
   blankCtr = blankCtr + 1
  If .Rows(i).Cells(1).End(xlUp).Row = 1 Then
  .Rows(i & ":" & .Rows(i).Cells(1).End(xlUp).Offset(1).Row).Delete
  Exit Sub
 End If

If blankCtr > 1 Then
.Rows(i).Delete
blankCtr = blankCtr - 1
End If

Else
blankCtr = 0
GoTo here

End If

here:
Next i
End With

Upvotes: -1

Related Questions