Reputation: 23
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:
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
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
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