Delete blank row only if 2 consecutive blank rows

[Guest]

Hi,

Thanks for all the help donated to this site. I have code that will delete
all blank rows but I acutally need to only delete the row if I have more than
1.

Following is the code I currently use for other projects:

Private Sub DeleteEmptyRows()

Dim LastRow As Long
Dim r As Long

LastRow = Sheets("Daily").UsedRange.Rows.Count
LastRow = LastRow + Sheets("Daily").UsedRange.Row - 1

For r = LastRow To 1 Step -1
If Application.CountA(Rows(r)) = 0 Then Rows(r).Delete
Next r

End Sub

Any ideas. Thanks. Amy

 

[JE McGimpsey]

One minor change:

Public Sub DeleteEmptyRows()
Dim LastRow As Long
Dim r As Long

LastRow = Sheets("Daily").UsedRange.Rows.Count
LastRow = LastRow + Sheets("Daily").UsedRange.Row - 1
For r = LastRow To 1 Step -1
If Application.CountA(Rows(r).Resize(2)) = 0 Then _
Rows(r).Delete
Next r
End Sub

 

[Guest]

Amy,

Change loop to look like this and it should work

For r = LastRow To 2 Step -1
If Application.CountA(Rows(r - 1 & ":" & r)) = 0 Then Rows(r - 1 &
":" & r).Delete
Next r