Delete Cells/Rows in Range, based on empty cells, or cells with specific values

Location: http://www.mvps.org/dmcritchie/excel/delempty.htm
Coding:  http://www.mvps.org/dmcritchie/excel/code/delempty.txt   (includes these + additional related macros)
Home Page: http://www.mvps.org/dmcritchie/excel/excel.htm

This page contains some VBA macros.  If you need assistance to install or to use a macro please refer to Getting Started with Macros.  For more depth see Install a Macro or User Defined Function  on my Formula page.   Speed and efficiency considerations can be seen in Proper, and other Text changes and in Slow Response.

Delete Empty Cells but don't disturb rows (#DEL95HTMLemptyCells)

The DEL95HTMLemptyCells is designed to clean up the mess that Excel 95 creates when pasting from a web page into Excel.  My experience with pasting Excel 95 was that instead of continuing a row across it also frequently jumped down a row besides for what should have been on the same row. The following macro attempts to fix that and is dependent on there being a value in Column A for every row in the original. This macro will move cells up if there is an empty cell above and column A cell is empty. Data at the right tests more than just what can happen with Excel 95 pasting. Sub DEL95HTMLemptyCells() 'David McRitchie, 2002-08-24, Worksheet Functions ' Move cells up into empty cell below if Column A cell ' on line to be moved up is empty. Application.ScreenUpdating = False Application.Calculation = xlManual '--Excel 95 Dim Rcnt As Long, Ccnt As Long, r As Long, c As Long Dim CurrCell As Range On Error Resume Next Selection.Replace What:=Chr(160), Replacement:=Chr(32), _ LookAt:=xlPart, SearchOrder:=xlByColumns, MatchCase:=True Rcnt = Cells.SpecialCells(xlLastCell).Row Ccnt = Cells.SpecialCells(xlLastCell).Column For r = Rcnt To 2 Step -1 If IsEmpty(Cells(Rcnt, 1)) Then For c = 1 To Ccnt If Not IsEmpty(Cells(r, c)) Then If Not IsEmpty(Cells(r - 1, c)) Then GoTo notthis End If Next c For c = 1 To Ccnt If Not IsEmpty(Cells(r, c)) Then Cells(r - 1, c) = Cells(r, c) End If Next c Cells(r, 1).EntireRow.Delete notthis: End If Next r Application.Calculation = xlAutomatic '--Excel 95 Application.ScreenUpdating = True End Sub

A B C D E F G 1 A1 B1 C1 D1 E1 F1 G1 2 A2 B2 C2 D2 E2 F2 G2 3 A3 B3 C3 D3 E3 F3 G3 4 A4 B4           5     C4 D4 E4     6           F4 G4 7               8               9 A5 B5 C5 D5 E5 F5 G5 10 A6 B6 C6 D6 E6 F6 G6 11 A7             12   B7           13     C7       G7 14       D7   F7   15         E7     16 A8 B8 C8 D8 E8 F8 G8 17 A9 B9 C9 D9 E9 F9 G9     A B C D E F G 1  A1 B1 C1 D1 E1 F1 G1 2 A2 B2 C2 D2 E2 F2 G2 3 A3 B3 C3 D3 E3 F3 G3 4 A4 B4 C4 D4 E4 F4 G4 5 A5 B5 C5 D5 E5 F5 G5 6 A6 B6 C6 D6 E6 F6 G6 7 A7 B7 C7 D7 E7 F7 G7 8 A8 B8 C8 D8 E8 F8 G8 9 A9 B9 C9 D9 E9 F9 G9

Delete Empty Cells and Cells with Only Spaces   (#DelCellsUp)

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

• Replace became available in Excel 2000 VBA, in prior versions of Excel use the worksheet function, same first three operands.  (#replace)
  Replace(expression, find, replace[, start[, count[, compare]]])
  Application.WorksheetFunction.SUBSTITUTE(text,old_text,new_text,instance_num)
• The use of Intersect speeds up the macro by reducing the range checked to within the used range, making selection of entire columns feasible.  More information on use of Intersect and some other aspects of the above code can be seen in the notations for the Proper macro.
• Insertions and deletions should always be done from the bottom so that all cells are checked.  Using the item count starts from the lower right cell in the range and goes backwards right to left then rightmost cell in range on row above.
• The HTML non-breaking-space ( ) character will be treated for removal as if a space.  Included in test because a lot of pasting from HTML pages is now being done.  Cells that are empty or contain only spaces will be deleted.
• Warning: Greenbar shading of alternate rows will be broken, unless you you use Conditional Formatting. 

Example   (#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   (#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 (#emptycells)

version for XL97 and up   (#xl97)

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

Actually there is a problem if you select more than 8,192 non-contiguous cells with your macro (MS KB 832293).

Similar code to delete entire rows when Column A is empty with the same consideration for MS KB 832293.

Sub del_COLA_empty()
    'D McRitchie http://www.mvps.org/dmcritchie/excel/delempty.htm 2004-01-10
    'based on  Matt Neuburg, PhD  http://www.tidbits.com/matt Aug 3, 1998
    'Loop required due to MS KB http://support.microsoft.com/?kbid=832293
    Dim i As Long
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual   'pre XL97 xlManual
    i = Cells.SpecialCells(xlCellTypeLastCell).Row
    For i = i To 1 Step -8000
      On Error Resume Next 'in case there are no blanks
      Range(Cells(Application.WorksheetFunction.Max(1, i - 7999), 1), _
         Cells(Application.WorksheetFunction.Max(i, 1), 1)). _
         SpecialCells(xlCellTypeBlanks).EntireRow.Delete
      On Error GoTo 0
    Next i
    Application.Calculation = xlCalculationAutomatic   'pre XL97 xlManual
    Application.ScreenUpdating = True
    ActiveSheet.UsedRange 'Resets UsedRange for Excel 97
End Sub

Generate test data (#testdata) for testing the above in a worst case scenario where every other row makes for most discontiguous cells possible.

A1:  A1              
B1:   1
c1:  =IF(ISTEXT(A1),A1&"",B1+0)
A2: (empty)    
A3:  A3
A4:  (empty)

Select B1:B20000,   Edit,  Fill,  Series
Select A1:A4,   double click on fill handle
Select C1,  double click on fill handle (left will be used for extent, since no cells on right)

Coloring of cells based on CellType, also serves as a Demonstration of Failure in SpecialCells (#failure / #coloring)

When you create a Microsoft Visual Basic for Applications (VBA) macro that selects multiple non-contiguous ranges in a Microsoft Excel workbook that uses a VBA expression that is similar to the following, actions that were only supposed to occur with blank cells occur to every cell that has been selected on the worksheet:expression.SpecialCells(xlCellTypeBlanks)expression

This behavior in SpecialCells occurs if you select more than 8,192 non-contiguous cells with your macro.  Excel only supports a maximum of 8,192 non-contiguous cells through VBA macros.

-- Thanks to Ron de Bruin for finding this problem and bringing attention to the MS KB article.  (see warnings on Special Cells)

The following table consists of test data generated above for a worst case scenario.  the tables are identically created but the first table is reduced to 20 rows, the second table consists of 20000 rows. 

The table below shows coloring added by the subroutine -- Column A has text constants or empty cells, Column B has number constants, Column C has formulas showing text constants or number constants.

Sub SpecialCells_Coloring()
 'demonstrates failure if more than 8192 cells selected by specialcells
 'see MS KB http://support.microsoft.com/?kbid=832293
 Dim rng As Range, cnt(5) As Long
 Set rng = ActiveSheet.UsedRange
 Cells.Interior.ColorIndex = xlNone
 On Error Resume Next
 rng.SpecialCells(xlCellTypeBlanks).Interior.ColorIndex = 36
 rng.SpecialCells(xlCellTypeConstants, xlTextValues).Interior.ColorIndex = 37
 rng.SpecialCells(xlCellTypeConstants, xlNumbers).Interior.ColorIndex = 38
 rng.SpecialCells(xlCellTypeFormulas, xlTextValues).Interior.ColorIndex = 39
 rng.SpecialCells(xlCellTypeFormulas, xlNumbers).Interior.ColorIndex = 40
 cnt(1) = rng.SpecialCells(xlCellTypeBlanks).Count
 cnt(2) = rng.SpecialCells(xlCellTypeConstants, xlTextValues).Count
 cnt(3) = rng.SpecialCells(xlCellTypeConstants, xlNumbers).Count
 cnt(4) = rng.SpecialCells(xlCellTypeFormulas, xlTextValues).Count
 cnt(5) = rng.SpecialCells(xlCellTypeFormulas, xlNumbers).Count
 On Error GoTo 0
 If cnt(1) + cnt(2) + cnt(3) + cnt(4) + cnt(5) <> rng.Count Then
    MsgBox "Results probably in error, including these numbers, " & _
     "see MS KB http://support.microsoft.com/?kbid=832293 " _
     & Chr(10) & "Blanks = " & cnt(1) _
     & Chr(10) & "Text Constants = " & cnt(2) _
     & Chr(10) & "Number Constants = " & cnt(3) _
     & Chr(10) & "Text from Formulas = " & cnt(4) _
     & Chr(10) & "Numbers from Formulas = " & cnt(5) _
     & Chr(10) & "actual cells in used area = " & rng.Count
 End If
End Sub

Actually if you want to check for the failure and program around the problem see Ron de Bruin's page SpecialCells limit problem where he has shown that there is a test that can be used to test for exceeding 8,192 areas.  For an idea of how important the use of Special Cells is see my page on Proper, and other Text changes -- Use of Special Cells

Version for XL95   (#xl95)

Compatibility between XL95 and XL97 is certain demonstrated in the differences between these two macros.

• xlblanks is used in XL95, but in XL97 it is xlCellTypeBlanks
• xlUp is used in XL95, but in XL97 it is xlShiftUp

The code of Matt Newburg 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   (#delemptymoveleft)

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 Newburg's code)

u
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 (#rows)

 Install a macro   instructions to install and use macros and User Defined Functions

Delete ALL rows with blank cells in a particular Column   (#deleterows)

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

To also delete rows where there is a zero in column A, you can change them to Blank and eliminate the rows as above, all without using a loop. -- Myrna Larson (example)
       Columns("A:A").Replace 0, "", xlWhole

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 are not numeric in Column E« (#deletenonnumeric_cole)

Because these are single instructions in VBA deleting rows all at once, there is no need for loops nor to turn off calculation or to turn off screen updating.  The second parameters of SpecialCells can be added together; unfortunately, you must use separate instructions for Formulas and for Constants.

There are no titles in Row 1 in this example, which makes for this simple example.

Sub DeleteNonNumeric_ColE()
  On Error Resume Next
  Range("e:e").SpecialCells(xlBlanks, _
      xlTextValues).EntireRow.Delete
  Range("e:e").SpecialCells(xlConstants, _
      xlTextValues).EntireRow.Delete
  Range("e:e").SpecialCells(xlFormulas, _
      xlTextValues + xlErrors + xlLogical).EntireRow.Delete
  On Error GoTo 0
End Sub

Delete ALL rows that are not numeric in Column E« (#deletenonnumeric_cole2dn)

But we can make this leave row 1 alone by including rows("2:" & rows.count)

Sub DeleteNonNumeric_ColE2DN()
  On Error Resume Next
  Intersect(Rows("2:" & Rows.Count), Range("e:e").SpecialCells(xlBlanks, _
      xlTextValues)).EntireRow.Delete
  Intersect(Rows("2:" & Rows.Count), Range("e:e").SpecialCells(xlConstants, _
      xlTextValues)).EntireRow.Delete
  Intersect(Rows("2:" & Rows.Count), Range("e:e").SpecialCells(xlFormulas, _
      xlTextValues + xlErrors + xlLogical)).EntireRow.Delete
  On Error GoTo 0
End Sub

Delete ALL rows that have cell in Column A that looks blank « (#DeleteRowsThatLookEmptyinColA)

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 that 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.

Modified to process all sheets   (#Allsheets_Delete_Rows_Empty_in_column_A)

For additional examples in processing all sheets see sheets.htm and collections.htm

Public Sub Allsheets_Delete_Rows_Empty_in_column_A()
  Application.Calculation = xlManual   'xl97 up use xlCalculationManual
  Application.ScreenUpdating = False
  Dim Rng As Range, ix As Long
  Dim csht As Long
  For csht = 1 To ActiveWorkbook.Sheets.Count  'worksheet or sheets
    Set Rng = Intersect(Worksheets(csht).Range("A:A"), _
       Worksheets(csht).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:
  Next csht
  Application.ScreenUpdating = True
  Application.Calculation = xlAutomatic   'xl97 up use xlCalculationAutomatic
End Sub

Delete ALL rows that are Entirely Blank (#RemoveEmptyRows)

Delete All Rows that are completely empty.  (see code page for comparable macro to RemoveEmptyColumns)

The code for DelEmmptyRows had to be changed for Excel 2002 on 2006-01-31 to remove use of SpecialCells in a range.  Considering problems with SpecialCells it is better this way.

 Install a macro   instructions to install and use macros and User Defined Functions

Sub DelEmptyRows()
  Dim i As Long, iLimit As Long
    iLimit = ActiveSheet.UsedRange.Rows.Count
  Application.ScreenUpdating = False
  Application.Calculation = xlCalculationManual    'pre XL97 xlManual
  For i = iLimit To 1 Step -1
    If Application.CountA(Cells(i, 1).EntireRow) = 0 Then
       Cells(i, 1).EntireRow.Delete
    End If
  Next i
   Application.Calculation = xlCalculationAutomatic
   Application.ScreenUpdating = True
   iLimit = ActiveSheet.UsedRange.Rows.Count   'attempt to fix lastcell
   ActiveWorkbook.Save
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 Zero in column   (#delrowswith0)

Sub Del_rows_with_zero_in_column_of_activecell()
  'Charles Chickering, programming, 2007-02-09
  Application.ScreenUpdating = False
  Application.Calculation = xlCalculationManual
  Const StartRow As Long = 1 'Row to Start looking at
  Dim StopRow As Long
  Dim Col As Long
  Col = ActiveCell.Column
  StopRow = Cells(Rows.Count, Col).End(xlUp).Row
  Dim cnt As Long
  For cnt = StopRow To StartRow Step -1
    If Not IsEmpty(Cells(cnt, Col)) Then
     If IsNumeric(Cells(cnt, Col)) Then
      If Cells(cnt, Col) = 0 Then Rows(cnt).Delete
     End If
    End If
  Next cnt
  Application.Calculation = xlCalculationAutomatic
  Application.ScreenUpdating = True
End Sub

Delete rows with "N" in Column 31   (#Delete_N_MarkedRows)

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

Delete rows with specific value in Column A and on same row specific value in column B (#Delete_rows_based_on_ColA_ColB)

Sub Delete_rows_based_on_ColA_ColB()
  Application.ScreenUpdating = False
  Application.Calculation = xlCalculationManual
  Dim cell As Range, rng As Range, i As Long
  Set rng = Columns("A").SpecialCells(xlConstants, xlTextValues)
  For i = rng.Count To 1 Step -1
     If LCase(rng(i).Value) = "standard" _
          And LCase(rng(i).Offset(0, 1).Value) = "card" _
            Then rng(i).EntireRow.Delete
  Next i
  Application.Calculation = xlCalculationAutomatic
  Application.ScreenUpdating = True
End Sub

Delete rows with specific values, new twist, make a union of ranges for delete (#Delete_Rows)

An interesting twist by paul ??, 2003-01-10, invoves creating a Union of ranges containing a specific value, and then deleting all of the rows at one time in one instruction.

Sub Delete_Rows()
' This macro deletes all rows on the active worksheet
' that have 1034, 1035, 1037 column E.
 Dim rng As Range, cell As Range, del As Range
 Set rng = Intersect(Range("E:E"), ActiveSheet.UsedRange)
 For Each cell In rng
   If (cell.Value) = "1034" _
    Or (cell.Value) = "1035" _
    Or (cell.Value) = "1037" Then
       If del Is Nothing Then
          Set del = cell
       Else: Set del = Union(del, cell)
       End If
    End If
 Next cell
 On Error Resume Next
 del.EntireRow.Delete
End Sub

Massive Delete Rows / Insert Rows for those selected in Column A   (#A_Selected_Delete_Rows)

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   (#MassDeleteAboveActive)

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

Delete ALL rows from A1 to find cell value in Column A   (#DelRows1toFind)

Sub DelRows1toFind()
    Dim rng As Range 'Tom Ogilvy, 2003-02-11, programming 
    Set rng = Columns(1).Find("feng", Cells(1, 1))
    If Not rng Is Nothing Then
        Range(Cells(1, 1), rng).EntireRow.Delete
    End If
End Sub

More deleting rows   (#DelRowNoAst)

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 Long
  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 a cell contains text "ANN" in any cell in range (#find)

This code will delete all rows where a cell contains the text "ANN" anywhere within such cells.
   e.g.   ANNxxx xxANNxx xxANN
From a posting by Patrick Molloy, programming, 2002-11-26

Sub Find_ANN()
    Dim rng As Range
    Dim what As String
    what = "ANN"
    Do
        Set rng = ActiveSheet.UsedRange.Find(what)
        If rng Is Nothing Then
            Exit Do
        Else
            Rows(rng.Row).Delete
        End If
    Loop
End Sub

Note that FIND in VBA is similar to the FIND shortcut (Ctrl+F); whereas InStr in VBA is similar to the FIND function in Excel. (See strings.htm if that interestes you.

Delete ALL rows where any cell is bold and has content     (#delbold)

Deletes any row beginning from row 2 that contains a bold cell that is not empty anywhere on the row.  Any cell with a space or a formula is by definition not empty.  Row 1 is exempt from deletion

Sub del_rows_with_bold()
   ' David McRitchie, 2005-09-01
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Dim Rcnt As Long, Ccnt As Long, r As Long, c As Long
    Dim CurrCell As Range
    On Error Resume Next
    Rcnt = Cells.SpecialCells(xlLastCell).Row
    Ccnt = Cells.SpecialCells(xlLastCell).Column
    '-- check up to row 2 from the bottom
    For r = Rcnt To 2 Step -1
       '-- check all cells on row beginning at column 1
       For c = 1 To Ccnt
         If Cells(r, c).Font.Bold And Not IsEmpty(Cells(r, c)) Then
            '-- Must be bold and have content
            Cells(r, c).EntireRow.Delete
            GoTo next_r
        End If
      Next c
next_r:
    Next r
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
End Sub

Delete ALL rows where cell value is equal to x in selected columns   (#deleteequal)

    (see previous topic for what is probably better)
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/default.aspx?scid=kb;en-us;Q213544
   '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   (#MoAli1)

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 (#DelEvenRows)

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

Delete Entire Rows for active cell or for Selection   (#DelSelection_Rows)

 Sub DelActiveCell_Row()
   ActiveCell.EntireRow.Delete
 End Sub

 Sub DelSelection_Rows()
   'in Excel 2000 multiple selections okay
   'if they don't overlap
   Selection.EntireRow.Delete
 End Sub

Delete x number rows above row 25

 rows(25).Offset(-x).Resize(x).delete

Delete old rows between header row and cell found in sheet3 cell C5

The following doesn't really belong on this page but someone wanted a modification of one of the macros on this page to delete rows 2 through the row before the found cell in Column A.

Sub DelRows2toBeforeFind()
    Dim rng As Range '2010-05-13 based on Tom Ogilvy, 2003-02-11, programming
    'look in column A for for value in Sheet3 cell C5,  if found delete
    '  rows 2 through the row before the found cell.
    dd = Worksheets("Sheet3").Range("C5").Value
    Set rng = Columns(1).Find(dd, Cells(2, 1))
    If Not rng Is Nothing Then
      If rng.Row > 2 Then
       Range(Cells(2, 1), rng.Offset(-1, 0)).EntireRow.Delete
      Else
        MsgBox "value """ & _
          Worksheets("sheet3").Range("C5").Value & """ Found but no lines deleted"
      End If
    Else
      MsgBox "value """ & _
        Worksheets("sheet3").Range("C5").Value & """ Not found in Column A"
    End If
End Sub

Just so I could use same test data this is checking column B instead of Column A, but the example is checking a date instead.

Sub DelRowsofOldDatesFind()
    Dim rng As Range 'Tom Ogilvy, 2003-02-11, programming
    dd = Worksheets("Sheet3").Range("C6").Value
    On Error Resume Next
    xx = "B2:B" & Application.Match(CLng(dd), Range("B2:B500"), 0)
    Set rng = Range(xx)
    If Not rng Is Nothing Then
       If rng.Row > 1 Then Range(Cells(2, 1), rng).EntireRow.Delete
    End If
End Sub

---

Related Items   (#related)

 Install a macro   to Sort All Sheets in a Workbook (rearrange the worksheet tabs)

• Color Palette -- 56 Excel Colors, Attempts to equate Excel ColorIndex values to RGB colors used in HTML.  Includes formatting colors: [BLACK] [BLUE] [CYAN] [GREEN] [MAGENTA] [RED] [WHITE] [YELLOW] [COLOR1]..[Color56] and other color information.  Color Sorting (on another page).
• Fill in the Empty Cells, this macro will fill in empty cells with the content of the cell above it, providing the cell above is also within the selection range.
• Insert ROW using a Macro, the macro described will insert row(s) below a selected row or cell.   The advantage of using a macro is that the formulas will be copied, but not the data; providing a more reliable method of inserting lines than simply inserting a row and then dragging a row with formulas and data into an inserted empty row.
• Reset Last Cell Used  Attempts to provide additional information concerning eliminating unused rows at end and unused columns to right of sheet beyond what can be seen in Q134617 244435 - How to reset the last cell in Excel  Back on my web page, MakeLastCell makes the activecell become the lastcell by deleting all rows and columns that appear after the active cell, and QueryLastCells lists sheets in workbook using an excessive number of cells, similar to information provided in BuildTOC on another page.

Related Information on Other Sites (#offsite)

• DeleteBlankRows() on Chip Pearson's pages.  If cell in the selected range (one column) is empty (ISBLANK) then the entire row will be deleted.  Warning no check is made for lastcell on sheet so select your range carefully.
• Conditional Row Delete, John Walkenbach, add-in requires Excel 97 or higher (73K self-extracting download).
• Clean up rows and columns past actual data for all sheets in the workbook, contextures.com, Debra Dalgleish, look for DeleteUnused macro, abandoned rows rows and column, contextures.com, Debra Dalgleish

Related Information in Postings   (#postings)

• Remove leading, trailing, and duplicate hyphens from selected cells that have constants (ignores formulas).
• Delete duplicates in column, and values duplicating values found on original sheet in the designated column, Tom Ogilvy, 2002-12-20, Re: Duplicate Rows for 5 Sheets.
• Remove content of cells with constants that look empty, but are not, David McRitchie, 2003-07-23, worksheet.functions -- not deleting the cells which would cause cells to move up, but only remove the constants so that they are in fact EMPTY.

Microsoft Knowledge Data Base (MS KB)   (#mskb)

(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 send email comments

---

Copyright © 1997 - 2009,  F. David McRitchie,  All Rights Reserved