Sub AutofilterRange(Optional ByVal Scope As Range)
'
' Autofilter Macro
'
Dim CurrCell As Range
Dim CurrCell1 As Range
Dim CurrRegion As Range
Dim CurrCol As Integer
Dim TwoCriteria As Boolean
If Not WorkbookActive Then
MsgBox "There are no suitable windows active to work with", vbInformation, "I can't work with this!"
Exit Sub
End If
Set CurrCell = Selection.Cells(1, 1)
Set CurrCell1 = Selection.Cells(2, 1)
If Selection.Rows.Count > 1 Then
TwoCriteria = True
Else
TwoCriteria = False
End If
If Scope Is Nothing Then
If ActiveSheet.AutoFilterMode Then ' there is an autofilter applied
Set CurrRegion = ActiveSheet.Autofilter.Range
Else ' no filter applied - need to identify region to filter
If Selection.Columns.Count * Selection.Rows.Count = 1 Then
Set CurrRegion = Selection.CurrentRegion
Else
Set CurrRegion = Selection
End If
End If
Else
Set CurrRegion = Scope
End If
CurrCol = CurrCell.Column - CurrRegion.Column + 1
If ActiveSheet.AutoFilterMode = True Then ' there is a filter in place
If Application.Intersect(CurrCell, ActiveSheet.Autofilter.Range) Is Nothing Then
' Active selection NOT in filtered list"
CurrRegion.Autofilter ' turn off autofilter
Call Message("Autofilter has been turned OFF", iClearMessage:=10)
Else
'Active selection in filtered list - add or remove criteria
If ActiveSheet.Autofilter.Filters(CurrCol).On Then 'filter already in place for the column
CurrRegion.Autofilter field:=CurrCol ' remove filter from column
Message ("Autofilter has been removed from the current column.")
Else ' not currenty a filtered colum so add a filter
If TwoCriteria Then
CurrRegion.Autofilter field:=CurrCol, Criteria1:=CurrCell.Text, _
Operator:=xlOr, Criteria2:=CurrCell1.Text ' add filters to column
Call Message("Autofilter has been added to the current column." & _
"Filter criteria is : =" & _
CurrCell.Text & " OR " & CurrCell1.Text, 10)
Else
CurrRegion.Autofilter field:=CurrCol, Criteria1:=CurrCell.Text ' add filter to column
Call Message("Autofilter has been added to the current column." & _
"Filter criteria is : =" & _
CurrCell.Text, 10)
End If
End If
End If ' processing where an autofilter exists
Else ' create filter for the list
If (CurrRegion.Columns.Count * CurrRegion.Rows.Count) > 1 Then
CurrRegion.Autofilter
Call Message("Autofilter has been turned ON for the current region", 10)
Else
MsgBox "You must select an area with data to autofilter." & vbCrLf & _
"Please select an area with data and retry.", _
vbOKOnly, "Cannot apply AutoFilter"
End If ' turn on autofilter
End If ' autofilter edit or create
Set CurrCell = Nothing
Set CurrCell1 = Nothing
Set CurrRegion = Nothing
End Sub