Delete Rows Meeting Condition/Criteria

Excel VBA: Delete Excel Rows Based on a Specified Condition or Criteria

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

Gallery

stars (0 Reviews)

Microsoft® and Microsoft Excel® are registered trademarks of Microsoft Corporation.
OzGrid is in no way associated with Microsoft.

Website designed by Astrava Solutions Ltd.