delete rows if there are 2 consecutive empty rows - excel

Question

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.

Answer 1

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

Answer 2

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

Answer 3

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