Option Explicit
Sub FilterData()
''''''''''''''''''''''''''
'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 = Range("a1:d16000")
Step2:
'We use Application.InputBox type 1 so return a number
lCol = 2
Step3:
'We use default InputBox type as we want Text
strCriteria = Range("c3")
'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
Bookmarks