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. |
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(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 Interect 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
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
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 SubVersion 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.
- 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, Delete
Sub DelEmptyMoveLeft() Cells.Select Selection.SpecialCells(xlCellTypeBlanks).Select Selection.Delete Shift:=xlToLeft End SubYou can reduce the above to: (note similarity to Matt Newberg's code)Sub DelEmptyMoveLeft() Cells.SpecialCells(xlCellTypeBlanks).Delete Shift:=xlToLeft End SubSuppose 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
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 97The 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 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 SubSee earlier note concerning REPLACE, which became available in Excel 2K VBA.Delete ALL rows that are Entirely Blank
Delete All Rows that are completely emptySub 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 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 "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 SubMassive Delete Rows / Insert Rows for those selected in Column A
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 SubDelete ALL rows above the active cell
Sub MassDeleteAboveActive() Rows("1:" & (ActiveCell.Row - 1)).Delete End Sub 'posted to programming 2000-02-19 D.McRitchie
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 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 SubxlBlanks for XL95, xlCellTypeBlanks above XL95 xlManual or XlAutomatic for XL95Delete 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 -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/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 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 IfClear 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 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
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
How to install/use a macro can be found on my formula page.
(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
Please send your comments concerning this web page to: David McRitchie mailto:DMcRitchie@msn.com