Follow along with the video below to see how to install our site as a web app on your home screen.
Note: This feature may not be available in some browsers.
Sub DelBlanks()
On Error Resume Next ' In case there are no blanks
Columns("A:A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
ActiveSheet.UsedRange 'Resets UsedRange for Excel 97
End Sub
Sub DeleteReallyBlankRows()
'Chip Pearson
'Will delete all rows that are entirely blank
Dim r As Long
Dim c As Range
Dim n As Long
Dim Rng As Range
On Error GoTo EndMacro
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
If Selection.Rows.Count > 1 Then
Set Rng = Selection
Else
Set Rng = ActiveSheet.UsedRange.Rows
End If
n = 0
For r = Rng.Rows.Count To 1 Step -1
If Application.WorksheetFunction.CountA(Rng.Rows(r).EntireRow) = 0 Then
Rng.Rows(r).EntireRow.Delete
n = n + 1
End If
Next r
EndMacro:
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
Sub DeleteEmptyRows()
'John Walkenbach
'Will delete all rows that are entirely blank
LastRow = ActiveSheet.UsedRange.Row - 1 + _
ActiveSheet.UsedRange.Rows.Count
Application.ScreenUpdating = False
For r = LastRow To 1 Step -1
If Application.CountA(Rows(r)) = 0 Then Rows(r).Delete
Next r
End Sub
Sub DeleteBlankRows()
'Delete empty Rows without
'the need to loop through all rows
Dim rng As Range
Dim sRng As String
Dim lRowCnt As Long
Dim vArr As Variant
Dim lRow As Long
Dim r As Long
On Error GoTo Handler
Application.ScreenUpdating = False
'get last row containing data and set range
'making initial assumption that empty cells in colA are empty rows
lRow = Cells.Find("*", , , , xlByRows, xlPrevious).Row
Set rng = Range("A1:A" & lRow).SpecialCells(xlCellTypeBlanks)
'turn range aroung to work with cells in reverse order
'using custom function
sRng = ReverseRange(rng.Address(False, False))
'manipulate range string to use as array
vArr = Split(sRng, ",")
For lRowCnt = LBound(vArr) To UBound(vArr)
'Allow for multiple consecutive rows, some of which might not be empty
'Still need to work in reverse here
For r = Range(vArr(lRowCnt)).SpecialCells(xlCellTypeLastCell).Row _
To Range(vArr(lRowCnt)).Cells(1, 1).Row Step -1
'Delete offending rows!!!!
If WorksheetFunction.CountA(Rows(r)) = 0 Then
Rows(r).EntireRow.Delete
End If
Next r
Next lRowCnt
'Clean up
Clean_Exit:
Set rng = Nothing
Application.ScreenUpdating = True
Exit Sub
Handler:
'No balnk cells in Col A ?
If Err.Description = "No cells were found." Then
MsgBox Err.Description
Resume Clean_Exit
End If
MsgBox Err.Description & " " & Err.Number
End Sub
Function ReverseRange(sRng As String) As String
'Reverses the order of cells in a range string
'to enable manipulation from last cell to first cell
Dim iEnd As Integer
Dim sTemp1 As String
iEnd = InStrRev(sRng, ",", Len(sRng) - 1)
sTemp1 = sRng
Do Until iEnd = 0
ReverseRange = ReverseRange & Right(sTemp1, Len(sTemp1) - iEnd) & ","
sTemp1 = Left(sRng, Len(sRng) - Len(ReverseRange))
iEnd = InStrRev(sTemp1, ",", Len(sTemp1) - 1)
Loop
ReverseRange = ReverseRange & Right(sTemp1, Len(sTemp1) - iEnd)
End Function
Sub DeleteBlankRows_V2()
'Delete empty Rows without
'the need to loop through all rows
Dim rng As Range
Dim lRowCnt As Long
Dim vArr As Variant
Dim lRow As Long
Dim r As Long
On Error GoTo Handler
Application.ScreenUpdating = False
'get last row containing data and set range
'making initial assumption that empty cells in colA are empty rows
lRow = Cells.Find("*", , , , xlByRows, xlPrevious).Row
Set rng = Range("A1:A" & lRow).SpecialCells(xlCellTypeBlanks)
'manipulate range string to use as array
vArr = Split(rng.Address(False, False), ",")
For lRowCnt = UBound(vArr) To 0 Step -1
'Allow for multiple consecutive rows, some of which might not be empty
'Still need to work in reverse here
For r = Range(vArr(lRowCnt)).End(xlDown).Row - 1 _
To Range(vArr(lRowCnt)).Cells(1, 1).Row Step -1
'Delete offending rows!!!!
If WorksheetFunction.CountA(Rows(r)) = 0 Then
Rows(r).EntireRow.Delete
End If
Next r
Next lRowCnt
'Clean up
Clean_Exit:
Set rng = Nothing
Application.ScreenUpdating = True
Exit Sub
Handler:
'No blank cells in Col A ?
If Err.Description = "No cells were found." Then
MsgBox Err.Description
Resume Clean_Exit
End If
MsgBox Err.Description & " " & Err.Number
End Sub