Sub DeleteBlank()
' remove rows with blank in column "B"

With Application
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
End With


For Each cell In Range("A1", Cells(Rows.Count, "A").End(xlUp))
If Cells(cell.Row, 2).Value = "" Then
    Cells(cell.Row, 2).EntireRow.Delete
End If
Next
With Application
    .ScreenUpdating = True
    .Calculation = xlCalculationAutomatic
End With

End Sub