alireza taghizadeh
alireza taghizadeh

Reputation: 23

Removing Blank Cell

In column A, we have numbers of 1 to 10 respectively And in column B we hold letters a to j which do not have order We removed 4 letters I do not want to change column A but column B removes her empty cells and letters writing following The following code removes rows with empty cells:

enter image description here

Sub DeleteEmptyRows()

'   Deletes the entire row within the selection if the ENTIRE row contains no data.

Dim i As Long
ActiveSheet.UsedRange.Select

With Application
    ' Turn off calculation and screenupdating to speed up the macro.
    .Calculation = xlCalculationManual
    .ScreenUpdating = False

    For i = Selection.Rows.Count To 2 Step -1
        If WorksheetFunction.CountA(Selection.Rows(i)) = 0 Then Selection.Rows(i).EntireRow.Delete
    Next i

    .Calculation = xlCalculationAutomatic
    .ScreenUpdating = True
End With

End Sub

Upvotes: 1

Views: 67

Answers (2)

Davesexcel
Davesexcel

Reputation: 6982

This solution will loop through the rangeAreas, copy the contents in Column B of that area, remove the blanks, and but the results back in column b, I requires column Z as a helper column

Sub Button1_Click()
    Dim RangeArea As Range, x

    For Each RangeArea In Columns("A").SpecialCells(xlCellTypeConstants, 1).Areas
        x = RangeArea.Rows.Count
        RangeArea.Offset(, 1).Copy [z1]
        Columns("Z:Z").SpecialCells(xlCellTypeBlanks).Delete Shift:=xlUp
        RangeArea.Offset(, 1).Value = Range("Z1:Z" & x).Value
        Range("Z:Z").Delete

    Next RangeArea

End Sub

Upvotes: 1

SJR
SJR

Reputation: 23081

I don't understand how you get from your first picture to the second, but if you start from the second, this will get you to the third.

Sub x()

On Error Resume Next 'avoid error if no blank cells
Columns("B").SpecialCells(xlCellTypeBlanks).Delete shift:=xlUp
On Error GoTo 0

End Sub

Upvotes: 1

Related Questions