A
aafraga
Dear Community,
I have coded an enhanced Autofilter algorithm that provides improved
funtionality for Autofilter users. Hopefully, I have not replicated
existing work in Excel.
I seem to have a problem with the event handler. Essentially, the row
above the Autofilter header now becomes a field to define criteria.
Essentially, the problem lies with the event
Workbook_SheetSelectionChange not activating upon a change to the cell.
This means that you need to revisit the cell for the macro to perform
its work.
All the code has been included. This resides in the ThisWorkbook
object. Improvements and fixes would be very much apprciated.
Alberto
Code:
--------------------
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
If ActiveSheet.AutoFilterMode Then
Dim af As AutoFilter
Set af = ActiveSheet.AutoFilter
Dim afCols As Integer
afCols = af.Range.Columns.Count
Dim afStart As Range
Set afStart = af.Range(1, 1)
If Target.Count = 1 Then
If InRange(Target, Range(afStart.Offset(-1, 0), afStart.Offset(-1, afCols - 1))) Then
If Target = "" Then
Selection.AutoFilter Field:=(Target.Column - afStart.Column + 1)
Else
searchPattern = Target
If Left(Target, 1) <> "<" And Left(Target, 1) <> ">" And Left(Target, 1) <> "=" Then
searchPattern = searchPattern & "*"
End If
Selection.AutoFilter Field:=(Target.Column - afStart.Column + 1), Criteria1:=searchPattern
End If 'NullTarget
End If 'InRange
End If 'Just One cell selected
End If 'AutoFilterMode
End Sub
Private Function InRange(Range1 As Range, Range2 As Range) As Boolean
' returns True if Range1 is within Range2
Dim InterSectRange As Range
Set InterSectRange = Application.Intersect(Range1, Range2)
InRange = Not InterSectRange Is Nothing
Set InterSectRange = Nothing
End Function
I have coded an enhanced Autofilter algorithm that provides improved
funtionality for Autofilter users. Hopefully, I have not replicated
existing work in Excel.
I seem to have a problem with the event handler. Essentially, the row
above the Autofilter header now becomes a field to define criteria.
Essentially, the problem lies with the event
Workbook_SheetSelectionChange not activating upon a change to the cell.
This means that you need to revisit the cell for the macro to perform
its work.
All the code has been included. This resides in the ThisWorkbook
object. Improvements and fixes would be very much apprciated.
Alberto
Code:
--------------------
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
If ActiveSheet.AutoFilterMode Then
Dim af As AutoFilter
Set af = ActiveSheet.AutoFilter
Dim afCols As Integer
afCols = af.Range.Columns.Count
Dim afStart As Range
Set afStart = af.Range(1, 1)
If Target.Count = 1 Then
If InRange(Target, Range(afStart.Offset(-1, 0), afStart.Offset(-1, afCols - 1))) Then
If Target = "" Then
Selection.AutoFilter Field:=(Target.Column - afStart.Column + 1)
Else
searchPattern = Target
If Left(Target, 1) <> "<" And Left(Target, 1) <> ">" And Left(Target, 1) <> "=" Then
searchPattern = searchPattern & "*"
End If
Selection.AutoFilter Field:=(Target.Column - afStart.Column + 1), Criteria1:=searchPattern
End If 'NullTarget
End If 'InRange
End If 'Just One cell selected
End If 'AutoFilterMode
End Sub
Private Function InRange(Range1 As Range, Range2 As Range) As Boolean
' returns True if Range1 is within Range2
Dim InterSectRange As Range
Set InterSectRange = Application.Intersect(Range1, Range2)
InRange = Not InterSectRange Is Nothing
Set InterSectRange = Nothing
End Function