Delete Empty rows ....Except when

[Stuart]

I've searched Google for this, but without success.
May have missed it, so a link would be appreciated.

I need to search a range (typically a few columns, but
many more rows)....say "A1:H5000", for rows that are
empty.

I cannot just delete every empty row. I have to preserve
one empty row. So when I find an empty row, I need to
find if there are any adjacent empty rows, and if so how
many. Then delete all but one.

I have found this (originally from Ron, then amended by
Tom) and wonder if an amendment to this code would
be the best approach:

Sub DeleteEmptyRowsRon()
Dim rng As Range, LastRow As Long, r As Integer
'JW
LastRow = ActiveSheet.UsedRange.Row - 1 + _
ActiveSheet.UsedRange.Rows.Count
Application.ScreenUpdating = False
For r = LastRow To 1 Step -1
If Application.CountA(Rows(r)) = 0 Then 'Rows(R).Delete
If rng Is Nothing Then
Set rng = Rows(r)
Else
Set rng = Union(rng, Rows(r))
End If
End If
Next r
rng.Delete
End Sub

I think I can see how Union might be used to create a
contiguous set of empty rows to be deleted, but that's
my limit.

Any help much appreciated.

Regards.

 

[Ron de Bruin]

Hi Stuart

See this page
http://www.rondebruin.nl/delete.htm

I like to loop(not so fast but is always working)

 

[Ron de Bruin]

I see I missed the
I put the kids in bed first and look at it for you if nobody else jump in

 

[Patrick Molloy]

Sub DeleteEmptyRowsRon()
Dim rng As Range, LastRow As Long, r As Integer
dim firstrow as long
' Find last blank row
For r = LastRow To 1 Step -1
If Application.CountA(Rows(r)) = 0 Then
firstrow = r
End If
Next r

' now remove blanks dwon to this row

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

End Sub

 

[Stuart]

Thanks.
I had already checked your link, however.
Hope 'little ones' need their sleep tonight !

Regards.

 

[Ron de Bruin]

Hi Stuart

If I understand you correct

Sub Example2()
Dim Lrow As Long
Dim CalcMode As Long
Dim StartRow As Long
Dim EndRow As Long
With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With

With ActiveSheet
.DisplayPageBreaks = False
StartRow = 2
EndRow = 100
For Lrow = EndRow To StartRow Step -1
If Application.CountA(.Rows(Lrow)) = 0 And _
Application.CountA(.Rows(Lrow - 1)) = 0 Then .Rows(Lrow).Delete
Next
End With
With Application
.ScreenUpdating = True
.Calculation = CalcMode
End With
End Sub

 

[Stuart]

Thanks, but that cycles up the range deleting all empty rows
as it goes, just preserving the first empty row it found.

I didn't explain myself clearly and I apologise.
Here is typical data in Col B:

qwerty 455


qwerty 461
qwerty 479



qwerty 480



qwerty492

I'm looking for a way to delete the empty rows, BUT to
leave one empty row between the sets of data.

Regards.

 

[Stuart]

Many thanks.

Despite my poor explanation!
Works fine.

Regards.

 

[Ron de Bruin]

Hi Stuart
No I must read good