Macro that delets empty cells between cells with text



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 _
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
If DelRng Is Nothing Then
Set DelRng = myArea
Set DelRng = Union(myArea, DelRng)
End If
End If
Next myArea

If DelRng Is Nothing Then
MsgBox "nothing to 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). _
If A.Count = 1 Then A.Delete xlShiftUp
End Sub

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question