Embedded blank rows

[Al]

I have the following code that was kindly provided by Tom Hutchins, it worked
perfectly for us but now there is one change that we'd like to make but are
not quite sure how to do it. (Many thanks to Tom for this great code)

Here is the code:

Dim Rng As Range

Sub DelEmptyRowsWithDV()
Dim c As Range
Do While CountEmptyCellsWithDV > 0
For Each c In Rng
If c.Validation.Type = 3 Then
With ActiveSheet
If Application.CountA(.Rows(c.Row)) = 0 Then
.Rows(c.Row).Delete
End If
End With
End If
Next c
Set Rng = Nothing
Loop
Application.Dialogs(xlDialogSaveAs).Show
End Sub

Private Function CountEmptyCellsWithDV() As Long
Dim x As Long, m As Range
On Error GoTo CECwDVerr
Set Rng = ActiveCell.SpecialCells(xlCellTypeAllValidation)
x = 0
For Each m In Rng
If Len(m.Value) = 0 And m.Validation.Type = 3 Then
x = x + 1
End If
Next m
CountEmptyCellsWithDV = x
Exit Function
CECwDVerr:
CountEmptyCellsWithDV = -1
End Function

This code removes blank rows (including cells with blank drop-down boxes)
and it works great as long as there are no embedded blank rows in the sheet.
As soon as there is one blank row somewhere in the middle, the macro hangs.

Could someone help proved the change needed to allow for blank rows in the
middle of the sheet? We want all trailing blank rows removed (they may
contain blank drop-downs)

Thanks in advance
Al

 

[Tom Hutchins]

Hi... I think I know what's going on. Empty rows aren't the problem; I had
lots of empty rows throughout my test worksheet. It's any row that's not
empty but which contains a blank cell with drop-down validation. The function
that recounts those cells after each row deletion will never reach zero in
that case, causing an infinite loop. Here is a revised version of the
function, which checks to make sure the whole row of empty:

Private Function CountEmptyCellsWithDV() As Long
Dim x As Long, m As Range
On Error GoTo CECwDVerr
Set Rng = ActiveCell.SpecialCells(xlCellTypeAllValidation)
x = 0
For Each m In Rng
If Len(m.Value) = 0 And m.Validation.Type = 3 Then
If Application.CountA(ActiveSheet.Rows(m.Row)) = 0 Then
x = x + 1
End If
End If
Next m
CountEmptyCellsWithDV = x
Exit Function
CECwDVerr:
CountEmptyCellsWithDV = -1
End Function

Hope this helps,

Hutch

 

[Al]

Thanks for taking the time to look at this, I really appreciate it.

I tried the new code you provided but unfortunately Excel still hangs if
there is a blank row with an empty drop-down.

Here is the complete new code I am using:

Dim Rng As Range

Sub DelEmptyRowsWithDV()
Dim c As Range
Do While CountEmptyCellsWithDV > 0
For Each c In Rng
If c.Validation.Type = 3 Then
With ActiveSheet
If Application.CountA(.Rows(c.Row)) = 0 Then
.Rows(c.Row).Delete
End If
End With
End If
Next c
Set Rng = Nothing
Loop
Application.Dialogs(xlDialogSaveAs).Show
End Sub

Private Function CountEmptyCellsWithDV() As Long
Dim x As Long, m As Range
On Error GoTo CECwDVerr
Set Rng = ActiveCell.SpecialCells(xlCellTypeAllValidation)
x = 0
For Each m In Rng
If Len(m.Value) = 0 And m.Validation.Type = 3 Then
x = x + 1
End If
Next m
CountEmptyCellsWithDV = x
Exit Function
CECwDVerr:
CountEmptyCellsWithDV = -1
End Function

Thanks again for your kind help
Al