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.
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
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]]])
- 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.
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
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 SubActually 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 SubGenerate 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)
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
Compatibility between XL95 and XL97 is certain demonstrated in the differences between these two macros.
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.
- xlblanks is used in XL95, but in XL97 it is xlCellTypeBlanks
- xlUp is used in XL95, but in XL97 it is xlShiftUp
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
Not for Excel 95. Valid only for Excel 97 and up the process multiple selections.
Based on recording a macro.
- select all cells (ctrl+a, or grey button left of column letters)
- Edit, GoTo, [Special], blanks
- Edit, DeleteSub DelEmptyMoveLeft() Cells.Select Selection.SpecialCells(xlCellTypeBlanks).Select Selection.Delete Shift:=xlToLeft End SubYou can reduce the above to: (note similarity to Matt Newburg's code)u Sub DelEmptyMoveLeft() Cells.SpecialCells(xlCellTypeBlanks).Delete Shift:=xlToLeft End SubSuppose you only want to remove blank cells in column 16 through rightmost column.
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
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
- Select the range in question, A1:A10.
- F5, Special, Blanks, OK.
- 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 SubSee 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.htmPublic 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.instructions to install and use macros and User Defined FunctionsSub 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 SubCells 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. --DavidSub 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.DeleteThe 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 SubxlBlanks 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-26Sub 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 SubNote 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 deletionSub 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 usesFor i = rng.Rows.Count To 1 Step -1but 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 SubPossible 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 IfPossible change -- check for any of several values, and possibly use TRIMIf 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 SubNote: 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 25rows(25).Offset(-x).Resize(x).delete
Delete old rows between header row and cell found in sheet3 cell C5The 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 SubJust 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)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
Q134617244435 - 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