
Lot's of free Excel VBA . Got any Excel Questions? Excel Help
Delete Rows Based on Condition
One very common question is: "how
can I delete rows from my Excel Worksheet based on a specified criteria, or
condition?" Below I have included the fastest 2 ways this can be done
with the use of the AutoFilter being the fastest by far. Both examples are
based on your data being in a contiguous range with the criteria/condition
to be looked for in the relative column of the table you specify. The first
row of your table should be headings.
Before running either code you should
select any single cell in your table.
Option Explicit Sub FastestAndMostFlexible() '''''''''''''''''''''''''' 'Written by www.ozgrid.com '''''''''''''''''''''''''' Dim rRange As Range Dim strCriteria As String Dim lCol As Long Dim rHeaderCol As Range Dim xlCalc As XlCalculation Const strTitle As String = "OZGRID CONDITIONAL ROW DELETE" On Error Resume Next Step1: 'We use Application.InputBox type 8 so user can select range Set rRange = Application.InputBox(Prompt:="Select range including header range" _ , Title:=strTitle & " STEP 1 of 3", Default:=ActiveCell.CurrentRegion.Address, Type:=8) 'Cancelled or non valid rage If rRange Is Nothing Then Exit Sub 'Awlays use GoTo when selecting range so doesn't matter which Worksheet Application.Goto rRange.Rows(1), True Step2 'We use Application.InputBox type 1 so return a number lCol = Application.InputBox(Prompt:="Please enter relative column number of evaluation column" _ , Title:=strTitle & " STEP 2 of 3", Default:=1, Type:=1) 'Cancelled If lCol = 0 Then Exit Sub Step3: 'We use default InputBox type as we want Text strCriteria = InputBox(Prompt:="Please enter a single criteria." & _ vbNewLine & "Eg >5 OR <10 OR Cat* OR *Cat OR *Cat*" _ , Title:=strTitle & " STEP 3 of 3") If strCriteria = vbNullString Then Exit Sub 'Store current Calculation then switch to manual. 'Turn off events and screen updating With Application xlCalc = .Calculation .Calculation = xlCalculationManual .EnableEvents = False .ScreenUpdating = False End With 'Remove any filters ActiveSheet.AutoFilterMode = False With rRange 'Filter, offset(to exclude headers) and delete visible rows .AutoFilter Field:=lCol, Criteria1:=strCriteria .Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete End With 'Remove any filters ActiveSheet.AutoFilterMode = False 'Revert back With Application .Calculation = xlCalc .EnableEvents = True .ScreenUpdating = True End With On Error GoTo 0 End Sub Sub DeleteRowsSecondFastest() '''''''''''''''''''''''''' 'Written by www.ozgrid.com '''''''''''''''''''''''''' Dim rTable As Range Dim rCol As Range, rCell As Range Dim lCol As Long Dim xlCalc As XlCalculation Dim vCriteria On Error Resume Next 'Determine the table range With Selection If .Cells.Count > 1 Then Set rTable = Selection Else Set rTable = .CurrentRegion On Error GoTo 0 End If End With 'Determine if table range is valid If rTable Is Nothing Or rTable.Cells.Count = 1 Or WorksheetFunction.CountA(rTable) < 2 Then MsgBox "Could not determine you table range.", vbCritical, "Ozgrid.com" Exit Sub End If 'Get the criteria in the form of text or number. vCriteria = Application.InputBox(Prompt:="Type in the criteria that matching rows should be deleted. " _ & "If the criteria is in a cell, point to the cell with your mouse pointer", _ Title:="CONDITIONAL ROW DELETION CRITERIA", Type:=1 + 2) 'Go no further if they Cancel. If vCriteria = "False" Then Exit Sub 'Get the relative column number where the criteria should be found lCol = Application.InputBox(Prompt:="Type in the relative number of the column where " _ & "the criteria can be found.", Title:="CONDITIONAL ROW DELETION COLUMN NUMBER", Type:=1) 'Cancelled If lCol = 0 Then Exit Sub 'Set rCol to the column where criteria should be found Set rCol = rTable.Columns(lCol) 'Set rCell to the first data cell in rCol Set rCell = rCol.Cells(2, 1) 'Store current Calculation then switch to manual. 'Turn off events and screen updating With Application xlCalc = .Calculation .Calculation = xlCalculationManual .EnableEvents = False .ScreenUpdating = False End With 'Loop and delete as many times as vCriteria exists in rCol For lCol = 1 To WorksheetFunction.CountIf(rCol, vCriteria) Set rCell = rCol.Find(What:=vCriteria, After:=rCell, LookIn:=xlValues, _ LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ MatchCase:=False).Offset(1, 0) rCell.Offset(1, 0).EntireRow.Delete Next lCol ` With Application .Calculation = xlCalc .EnableEvents = True .ScreenUpdating = True End With On Error GoTo 0 End Sub
Excel Dashboard Reports & Excel Dashboard Charts 50% Off Become an ExcelUser Affiliate & Earn Money
Special! Free Choice of Complete Excel Training Course OR Excel Addins Collection on all purchases totaling over $64.00. ALL purchases totaling over $150.00 gets you BOTH! Purchases MUST be made via this site. Send payment proof to special@ozgrid.com 31 days after purchase date.
Instant Download and Money Back Guarantee on Most Software
Excel Trader Package Technical Analysis in Excel With $139.00 of FREE software!
Microsoft ® and Microsoft Excel ® are registered trademarks of Microsoft Corporation. OzGrid is in no way associated with Microsoft
Some of our more popular products are below...
Convert Excel Spreadsheets To Webpages  Trading In Excel  Construction Estimators  Finance Templates & Addins Bundle  CodeVBA  SmartVBA  PrintVBA  Excel Data Manipulation & Analysis  Convert MS Office Applications To......  Analyzer Excel  Downloader Excel
 MSSQL Migration
Toolkit 
Monte Carlo Addin 
Excel
Costing Templates