 |
|
|
|
|
|
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 Add-ins 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
GIVE YOURSELF OR YOUR COMPANY 24/7 MICROSOFT EXCEL SUPPORT & QUESTIONS