Makro starten wenn Autofilter geändert wird

Rainer · 2018-03-07T10:51:47+00:00

Hallo zusammen, gibt es eine Möglichkeit, beim Ändern einen Autofilters automatisch ein Makro zu starten? Also kann ich im Worksheet_Change Event erkennen, dass ein Autofilter benutzt wurde? Danke und Gruß, Rainer

Update:
Ich kann jetzt auch die Sortierung erkennen. Juhu.
Aber leider löst der Selection_Change Event erst aus, NACHDEM eine Sortierung angewendet wurde.
Bei Anwenden einen Autofilters löst er GARNICHT aus.
Alles großer Mist.
Bedingten Erfolg habe ich mit folgender Anordnung:


Public AF1()
Public SortColumn
Public SortType
'from https://www.mrexcel.com/forum/excel-questions/333961-capture-autofilter-state.html
'modifed by Rainer, SortColumn and SortType added
Public Function Autofilter_Monitor()
Dim w As Worksheet
Dim currentFiltRange As String
Dim col As Integer
Set w = ActiveSheet
' Capture AutoFilter settings
With w.AutoFilter
currentFiltRange = .Range.Address
With .Filters
ReDim AF1(1 To .Count, 1 To 3)
For f = 1 To .Count
With .Item(f)
If .On Then
AF1(f, 1) = .Criteria1           '!!!! Geht nicht bei Datum
If .Operator Then
AF1(f, 2) = .Operator
End If
End If
End With
Next f
End With
With .Sort.SortFields
If .Count = 1 Then      'Sort is active
SortColumn = .Item(1).Key.Column
SortType = .Item(1).Order
End If
End With
End With
End Function
Public Function Autofilter_Change() As Boolean
Dim w As Worksheet
Dim currentFiltRange As String
Dim col As Integer
Autofilter_Change = False
Set w = ActiveSheet
' Capture AutoFilter settings
With w.AutoFilter
currentFiltRange = .Range.Address
With .Filters
For f = 1 To .Count
With .Item(f)
If .On Then
If AF1(f, 1)  .Criteria1 Then Autofilter_Change = True
If .Operator Then
If AF1(f, 2)  .Operator Then Autofilter_Change = True
End If
End If
End With
Next f
End With
With .Sort.SortFields
If .Count = 1 Then      'Sort is active
If SortColumn  .Item(1).Key.Column Then FilAutofilter_ChangeterChangeEvent =  _
True
If SortType  .Item(1).Order Then Autofilter_Change = True
End If
End With
End With
End Function

dies kombiniert mit dem Tipp von UweD (es braucht ein HEUTE() um ein "Calculate" sicher auszulösen) und folgendem Code funktioniert teilweise:


Private Sub Worksheet_Calculate()
If Autofilter_Change = True Then Sort_the_Sheets
Call Autofilter_Monitor
End Sub

Leider gibt mit "Criteria1" einen "Anwendungs- oder objektdefinierter Fehler" aus, wenn die Spalte mit "Datum" gefiltert wird. Die Fehlernummer ist 1004.
Für weitere Ideen bin ich dankbar.
Ich habe nur eine Variante gefunden, wo man die Datei als xml speichern soll und dort ausliest. Das ist aber viel zu lang um "heimlich" im Hintergrund zu laufen.
Gruß,
Rainer

Hallo zusammen,
hier nun der Code der JEDEN Autofilter/Sortierung (außer Datum) vergleichen kann.
Es braucht zusätzlich eine volatile Formel (Datum, Uhrzeit, Zufallszahl) im Blatt um Worksheet_Change Events auszulösen. Dieser prüft dann zuerst das Resultat von "Autofilter_Change".
Im Workbook_Open wird zum einen der Autofilter Zustand aufgenommen und die Filter für Datumsspalten abgeschaltet.

'Private Sub Workbook_Open()
'Disable Autofilters for Date columns, as they cause errors
'Sheets("Overview").Range("A2:Z2").AutoFilter Field:=8, VisibleDropDown:=False
'Sheets("Overview").Range("A2:Z2").AutoFilter Field:=14, VisibleDropDown:=False
'Call Autofilter_Monitor
Public Function Autofilter_Monitor()
On Error GoTo hell
Dim w As Worksheet
Dim currentFiltRange As String
Dim col As Integer
Set w = ActiveSheet
' Capture AutoFilter settings
With w.AutoFilter
currentFiltRange = .Range.Address
With .Filters
ReDim AF1(1 To .Count, 1 To 4)
For f = 1 To .Count
With .Item(f)
If .On Then
AF1(f, 1) = True
AF1(f, 2) = .Criteria1
If .Operator Then
AF1(f, 3) = .Operator
If .Operator = xlAnd Or .Operator = xlOr Then AF1(f, 4) = . _
Criteria2
End If
End If
End With
Next f
End With
ReDim SF1(1 To 9)
If .Sort.SortFields.Count = 1 Then
SF1(1) = .Sort.SortFields.Count
With .Sort.SortFields.Item(1)
SF1(2) = .Key.Column
SF1(3) = .SortOn
SF1(4) = .Order
SF1(5) = .DataOption
End With
With .Sort
SF1(6) = .Header
SF1(7) = .MatchCase
SF1(8) = .Orientation
SF1(9) = .SortMethod
End With
End If
End With
hell:
End Function
Public Function Autofilter_Change() As Boolean
On Error GoTo hell
If Not IsArray(AF1) Then            'On first run this will happen, or when AF1 not initialized
GoTo hell
End If
Dim w As Worksheet
Dim currentFiltRange As String
Dim col As Integer
Autofilter_Change = False
Set w = ActiveSheet
' Capture AutoFilter settings
With w.AutoFilter
currentFiltRange = .Range.Address
With .Filters
For f = 1 To .Count
With .Item(f)
If .On = True And IsEmpty(AF1(f, 2)) Then GoTo hell
If .On = False And Not IsEmpty(AF1(f, 2)) Then GoTo hell
If .On = True And Not IsEmpty(AF1(f, 2)) Then
If VarType(AF1(f, 2))  VarType(.Criteria1) Then GoTo hell
If VarType(.Criteria1) > 8000 Then
If Join(AF1(f, 2))  Join(.Criteria1) Then GoTo hell
Else
If AF1(f, 2)  .Criteria1 Then GoTo hell
End If
If .Operator Then
If AF1(f, 3)  .Operator Then GoTo hell
If .Operator = xlAnd Or .Operator = xlOr Then
If AF1(f, 4)  .Criteria2 Then GoTo hell
End If
End If
End If
End With
Next f
End With
If .Sort.SortFields.Count  SF1(1) Then GoTo hell
With .Sort.SortFields.Item(1)
If SF1(2)  .Key.Column Then GoTo hell
If SF1(3)  .SortOn Then GoTo hell
If SF1(4)  .Order Then GoTo hell
If SF1(5)  .DataOption Then GoTo hell
End With
With .Sort
If SF1(6)  .Header Then GoTo hell
If SF1(7)  .MatchCase Then GoTo hell
If SF1(8)  .Orientation Then GoTo hell
If SF1(9)  .SortMethod Then GoTo hell
End With
End With
GoTo FunctionEnd
hell:
MsgBox "Autofilter_Change = True"
FunctionEnd:
End Function

Makro starten wenn Autofilter geändert wird

Forumthread: Makro starten wenn Autofilter geändert wird

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Infobox / Tutorial