Delete Cells/Rows in Range, based on empty cells

Location: http://www.mvps.org/dmcritchie/excel/delempty.htm
Home Page: http://www.mvps.org/dmcritchie/excel/excel.htm

Assistance to Install a Macro or User Defined Function  on my Formula page.

Delete Empty Cells and Cells with Only Spaces

Warning:  This section Deletes Cells, Deleting Rows is in the next section.
The DelCellsUp macro will delete all empty cells within the highlighted range and move the cells and formatting up from below.  Cells deleted will only be deleted from within range; but cells moved up includes cells from below range. 
Sub DelCellsUp()
  'David McRitchie  1998-07-17 revised 2002-01-17
  '  http://www.mvps.org/dmcritchie/excel/delempty.htm
  'Delete Empty Cells and cells with only spaces in range
  '  and move cells up from below even if not in range
  'Will process single range of one or more columns
  'Will not remove cells with formulas
  Application.ScreenUpdating = False
  Application.Calculation = xlCalculationManual   'pre XL97 xlManual
  Dim rng As Range, ix As Long
  Set rng = Intersect(Selection, ActiveSheet.UsedRange)
  If rng Is Nothing Then
     MsgBox "nothing in Intersected range to be checked/removed"
     GoTo done
  End If
  For ix = rng.Count To 1 Step -1  'CHR(160) is non-breaking space
      If Len(Trim(Replace(rng.Item(ix).Formula, Chr(160), ""))) _
         = 0 Then rng.Item(ix).Delete (xlUp)
  Next
done:
  Application.Calculation = xlCalculationAutomatic
  Application.ScreenUpdating = True
End Sub

Example

Selecting the Range A1:C7 and then running the above macro.  Note that the yellow formatted cells that are deleted will be lost and cell move up to replace the deleted cells.  The grey in the AFTER is used to help differentiate the original selection range, but only the yellow cells retain the original formatting.

BEFORE
 
A B C D
1 A1 B1 C1 D1
2   B2 C2 D2
3       D3
4   B4 C4 D4
5       D5
6 A6 B6 C6 D6
7 A7 B7 C7 D7
8 ZZZ ZZZ ZZZ D8
9 xx   xx D9
10     xx D10
11     xx D11
12 A12 B12 C12 D12
   AFTER
 
A B C D
1 A1 B1 C1 D1
2 A6 B2 C2 D2
3 A7 B4 C4 D3
4 ZZZ B6 C6 D4
5 xx B7 C7 D5
6   ZZZ ZZZ D6
7     xx D7
8 A12   xx D8
9     xx D9
10   B12 C12 D10
11       D11
12       D12

The test data used in the above illustration was generated using MarkCells then some cells were deleted and some cells include only spaces before running DelCellsUp.  It doesn't matter whether the cells contained only spaces or were empty, DelCellsUp eliminates both.

Some thoughts for future

Some Coding that was used during creation of above or may get used later.  I will be wanting to create a similar macro that restricts operations within the range -- in other words one that does not move cells up from below range. Also another macro to move cells left instead of up. 
  'Set lastcell = cells.SpecialCells(xlLastCell)
  'maxrow = lastcell.Row     'will want to limit scope

  '-mark selection range in pale yellow
  'Selection.Interior.Color = RGB(255, 255, 192)

  '-mark empty cells xlblanks that would be deleted with magenta
  'Selection.SpecialCells(xlBlanks).Interior.Color = RGB(255, 0, 255)
  'v = Selection.Item(ir, ic).Value
  'If Len(v) = 0 Then Selection.Item(ir, ic).Delete

Delete only the Empty cells

version for XL97 and up

In Excel a Blank cell is a cell that has never had anything entered into it.  A cell that has it's contents deleted with the Del key also qualifies.  A cell that contains spaces or an unprinted zero do not qualify as a blank cell.  ISBLANK() is the equivalent worksheet test for VBA xlBlanks in XL95 or xlCellTypeBlanks in XL97.

Someone is always going to come up with something better.  This one liner was posted by Matt Neuburg, Aug 3, 1998 in excel.programming.  It does not run on my XL95, it is for XL97 and above.  (see version for XL95 below) 

Sub DelEmpty()
   'Matt Neuburg, PhD  http://www.tidbits.com/matt Aug 3, 1998
   Selection.SpecialCells(xlCellTypeBlanks).Delete (xlShiftUp)
End Sub

Version for XL95

Compatibility between XL95 and XL97 is certain demonstrated in the differences betwee these two macros. The code of Matt Newbur above that is so short requires more coding in XL95, following is the equivalent XL95.  It is the same as code I created for DelCellsUp, but only eliminates xlBlanks cells.

Sub DelEmpty()
  'David McRitchie  08/08/1998
  '  http://www.mvps.org/dmcritchie/excel/excel.htm
  'Delete Empty Cells and move cells up from below even
  'if not in range.  Will process ranges of one or more columns
  Application.ScreenUpdating = False
  For ix = Selection.Count To 1 Step -1
      If Selection.Item(ix) = x1Blanks Then _
         Selection.Item(ix).Delete (xlUp)
  Next ix
  Application.ScreenUpdating = True
 End Sub

Removing Empty Cells and Shifting Left

Not for Excel 95.  Valid only for Excel 97 and up the process multiple selections.

Based on recording a macro.

  1. select all cells (ctrl+a, or grey button left of column letters)
  2. Edit, GoTo, [Special], blanks
  3. Edit, Delete 
Sub DelEmptyMoveLeft()
    Cells.Select
    Selection.SpecialCells(xlCellTypeBlanks).Select
    Selection.Delete Shift:=xlToLeft
End Sub
You can reduce the above to: (note similarity to Matt Newberg's code) 
Sub DelEmptyMoveLeft()
    Cells.SpecialCells(xlCellTypeBlanks).Delete Shift:=xlToLeft
End Sub
Suppose you only want to remove blank cells in column 16 through rightmost column.
    Columns("P:IV").Select
for selection, but that would be dependent on 256 columns
See coding below not dependent on 256 columns. 
Sub DelEmptyMoveLeft_StartColumnP()
    Range(Cells(1, 16), Cells(1, Columns.Count)).EntireColumn.Select
    Selection.SpecialCells(xlCellTypeBlanks).Select
    Selection.Delete Shift:=xlToLeft
End Sub

Deleting Rows

Delete ALL rows with blank cells in a particular Column

In a posting 1998-05-17 to programming newsgroup, Dana DeLouis points out that SpecialCells frequently provides a quick method of eliminating loops, and because SpecialCells is limited to the UsedRange it will not be wasting time looping through the end of a worksheet.  His Example: 
    On Error Resume Next     ' In case there are no blanks
    Columns("A:A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    ActiveSheet.UsedRange 'Resets UsedRange for Excel 97

The above does not work in XL95 and earlier versions.  You get an error about not being able to do this with a multiple selection. -- Myrna Larson

An equivalent Worksheet solution provided by Jim Rech 2001-02-28

  1. Select the range in question, A1:A10.
  2. F5, Special, Blanks, OK.
  3. Ctrl-Minus and pick Shift Cells Up or Entire Row.

Delete ALL rows that have cell in Column A that looks blank «

Keeping in mind that cells that have spaces or formulas are never blank but could appear to be to the casual observer, the following will TRIM the value of the cell and check for a length of 0.  Since data could come from HTML a non-breaking space ( ) or CHR(160) will be treated as a space which is CHR(32).  The TrimALL macro is a another macro the takes the   character into consideration when trimming. 
Sub DeleteRowsThatLookEmptyinColA()
  Application.ScreenUpdating = False
  Application.Calculation = xlCalculationManual   'pre XL97 xlManual
  Dim Rng As Range, ix As Long
  Set Rng = Intersect(Range("A:A"), ActiveSheet.UsedRange)
  For ix = Rng.Count To 1 Step -1
      If Trim(Replace(Rng.Item(ix).Text, Chr(160), Chr(32))) = "" Then
        Rng.Item(ix).EntireRow.Delete
      End If
  Next
done:
  Application.Calculation = xlCalculationAutomatic
  Application.ScreenUpdating = True
End Sub
See earlier note concerning REPLACE, which became available in Excel 2K VBA.

Delete ALL rows that are Entirely Blank

Delete All Rows that are completely empty 
  Sub RemoveEmptyRows()
    Application.ScreenUpdating = False  'xlManual below in Xl95
    Application.Calculation = xlCalculationManual 
    Dim rw As Long, iCol As Long
    For rw = ActiveSheet.UsedRange.Rows.Count To 1 Step -1
      If Application.CountA(Rows(rw).EntireRow) = 0 Then _
            Rows(rw).Delete
    Next
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True  'xlAutomatic above in xl95
  End Sub
Cells that look blank may contain spaces and are therefore not blank (ISBLANK) in Excel's unfortunate choice of wording.  Cells with formulas will never test as ISBLANK.  (ISBLANK in MS Excel terms really means NULL never used or at least no content).
Related:  To make the activecell become the lastcell for the sheet, deleting all columns and rows after that cell see MakeLastCell.  Also of interest might be Insert a Row using a Macro to maintain formulas.

Delete rows with "N" in Column 31

Sub Delete_N_MarkedRows()
   Application.ScreenUpdating = False
   Application.Calculation = xlCalculationManual
   Dim lastrow As Long, r As Long
   lastrow = ActiveSheet.UsedRange.Rows.Count
   For r = lastrow To 1 Step -1
      If UCase(Cells(r, 31).Value) = "N" Then Rows(r).Delete
   Next r
   Application.Calculation = xlCalculationAutomatic
   Application.ScreenUpdating = True
End Sub

Massive Delete Rows / Insert Rows for those selected in Column A

Thought I had something new here but almost same as those above. --David 
   Sub A_Selected_Delete_Rows()
     Intersect(Selection, Range("A:A"), _
         ActiveSheet.UsedRange).EntireRow.Delete
   End Sub

   Sub A_Selected_Insert_Rows()
     Intersect(Selection, Range("A:A"), _
         ActiveSheet.UsedRange).EntireRow.Insert
   End Sub

Delete ALL rows above the active cell

   Sub MassDeleteAboveActive()
       Rows("1:" & (ActiveCell.Row - 1)).Delete
   End Sub   'posted to programming 2000-02-19  D.McRitchie

More deleting rows

This will delete rows for which a cell in the selection area is blank. 
      Selection.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
The following will process only cells with Text constants, when looking to delete non asterisk rows. 
Sub DelRowNoAst()
  Application.ScreenUpdating = False
  Application.Calculation = xlCalculationManual          'in XL97
  Dim ix As Integer
  If Selection.Columns.Count <> 1 Then
      MsgBox "Only select one column to retain rows with asterisks"
      Exit Sub
  End If
  Selection.SpecialCells(xlBlanks).EntireRow.Delete
  Selection.SpecialCells(xlCellTypeConstants).Select
  For ix = Selection.Count To 1 Step -1
      If Selection.Item(ix) <> "*" Then _
         Selection.Item(ix).EntireRow.Delete
  Next ix
  Application.Calculation = xlCalculationAutomatic     'in XL97
  Application.ScreenUpdating = True
End Sub
xlBlanks for XL95, xlCellTypeBlanks above XL95 xlManual or XlAutomatic for XL95

Delete ALL rows where cell value is equal to x in selected columns

The following is based in MS KB article Q213544 which I believe was poorly written. Actually it's purpose was to show that bad code did not work consistently in different versions, but the recommended and alternate codings were in my opinion not of good design either.

Forget the recommended way in Q159915 and Q213544 The Alternate one thrown in at the end of the articles which starts from the bottom and deletes rows without stepping over it's own toes is better in that it uses 

     For i = rng.Rows.Count To 1 Step -1
but still leaves some some fairly poor coding.

FWIW adjusting a counter used within a loop is not legal in all languages anyway and in others destroys optimization. Adjusting the variable within the FOR ... Next loop is harder to follow the coding and apparently is not consistent between Excel versions.

My opinion is that all of them are bad examples because they used hard coded ranges.  Use of rows should use Long instead of Integer at least in XL97 and up where rows can go up to 65,536 way beyond 16,384 rows in XL95.

Integer variables are stored as 16-bit (2-byte) numbers ranging in value from -32,768 to 32,767

Long (long integer) variables are stored as signed 32-bit (4-byte) numbers ranging in value from -2,147,483,648 to 2,147,483,647.

Have included turning off calculation and screen updating to make it run faster.  In XL95 use xlManual and xlAuto instead. Excel constants begin with XL in lowercase just so you won't confuse with other letters or numbers.  

Sub DeleteCells4()
   'modified from http://support.microsoft.com/support/kb/articles/Q213/5/44.asp
   'see http://www.mvps.org/dmcritchie/excel/delempty.htm

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual   'pre XL97 xlManual
    Dim rng As Range, i As Long   '// modified

    'Set the range to evaluate to rng.  // modified
    Set rng = Intersect(Selection, ActiveSheet.UsedRange)
    If rng Is Nothing Then
       MsgBox "nothing in Intersected range to be checked"
       GoTo done
    End If

    'Loop backwards through the rows
    'in the range that you want to evaluate.
    '--- For i = rng.Rows.Count To 1 Step -1  // modified

    For i = rng.Count To 1 Step -1

        'If cell i in the range contains an "x", delete the entire row.
        If rng.Cells(i).Value = "x" Then rng.Cells(i).EntireRow.Delete
    Next
  done:
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
End Sub
Possible change -- restrict to column A only: 
   Set rng = Intersect(Selection, Range("A:A"), ActiveSheet.UsedRange)
   If rng Is Nothing Then
       MsgBox "nothing in Intersected range to be checked," _
         & Chr(10) & "there is an internal range(""a:a"")"
       GoTo done
   End If
Possible change -- check for any of several values, and possibly use TRIM 
   If rng.cells(i).value = "x"  Or  TRIM(rng.cells(i).value) = "delete" then
      rng.Cells(i).EntireRow.Delete
   End If

Clear Content of adjacent cells where cell in Column G appears blank

Sub MoAli1()
  'Clear out values in Gx:Mx when value in col G appears empty
  'see http://www.mvps.org/dmcritchie/excel/delempty.htm 2000/07/29
  Application.ScreenUpdating = False
  Application.Calculation = xlCalculationManual
  Dim cell As Range
  For Each cell In Application.Intersect(ActiveSheet.Range("g:g"), _
         ActiveSheet.UsedRange)
    If Trim(cell.Value) = "" Then
        ActiveSheet.Range(cell, cell.Offset(0, 6)).ClearContents
    End If
  Next
  Application.Calculation = xlCalculationAutomatic
  Application.ScreenUpdating = True
End Sub
Note: Test for ISEMPTY(cell.value) not needed with TRIM(cell.value) but might be useful for modified code.
Certain aspects of code can be found in examples in slowresp.htm, turning calculation off for speed; proper.htm, see comments at top, including use of INTERSECT; join.htm, general information, include MarkCells used to create test data.

Delete All Even Numbered Rows

Perhaps this could be done without a loop but here is one way. 
 Sub DelEvenRows()
  'David McRitchie  2002-03-11 misc
  'Delete Even numbered rows from the bottom
  Application.ScreenUpdating = False
  Dim ix As Long
  For ix = Cells.SpecialCells(xlLastCell).Row To 2 Step -1
      If ix Mod 2 = 0 Then Rows(ix).Delete
  Next ix
  Application.ScreenUpdating = True
 End Sub

Related Items

How to install/use a macro can be found on my formula page.

Related Information in Postings

<>

Related Information on Other Sites

Microsoft Knowledge Data Base (MS KB)

(the following is just a place holder and will be changed)
Q107564 XL: Not All Worksheet Functions Supported as Application (in VBA)
Run-Time Error '438':
Object doesn't support this property or method
This page was introduced on July 17, 1998. 

[My Excel Pages -- home]    [INDEX to my site and the off-site pages I reference] 
[Site Search -- Excel]     [Go Back]    [Return to TOP] 

Please send your comments concerning this web page to: David McRitchie mailto:DMcRitchie@msn.com