Macro that delets empty cells between cells with text

[andrei]

Let's say i have column A with :

A1: boy
A2: empty cell
A3: girl
A4: empty cell
A5 empty cell
A6: nice

I want a macro which delets empty cells between cells with text . But the
macro should delete the cell only if there is ONE empty cell between cells
with text . If there are more than one , leaves it . In my case , it should
delete A2 cell but should keep A4 and A5 cell because there are two empty
cells bettween cells with text , which is OK !

 

[Dave Peterson]

The cells are really empty--no formulas, no nothing, right?

If yes:

Option Explicit
Sub testme()

Dim myRng As Range
Dim myArea As Range
Dim DelRng As Range
Dim wks As Worksheet

Set wks = Worksheets("Sheet1")

With wks
Set myRng = Nothing
On Error Resume Next
Set myRng = .Range("A1").EntireColumn _
.Cells.SpecialCells(xlCellTypeBlanks)
On Error GoTo 0
End With

If myRng Is Nothing Then
MsgBox "No empty cells in column A"
Exit Sub
End If

For Each myArea In myRng.Areas
If myArea.Rows.Count > 1 Then
'skip it
Else
If DelRng Is Nothing Then
Set DelRng = myArea
Else
Set DelRng = Union(myArea, DelRng)
End If
End If
Next myArea

If DelRng Is Nothing Then
MsgBox "nothing to delete!"
Else
DelRng.EntireRow.Delete
End If
End Sub

 

[Rick Rothstein]

Give this macro a try...

Sub DeleteSingleBlanks()
Dim LastRow As Long, A As Range
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
For Each A In Range("A1").Resize(LastRow). _
SpecialCells(xlCellTypeBlanks).Areas
If A.Count = 1 Then A.Delete xlShiftUp
Next
End Sub

 

[andrei]

Thanks guys for your help !