0

I tried to implement a AdvancedAutoFilter with VBA. This works just fine. But unfortunately when changing something in the file, to AutoFilter gets de-selected. I fixed this by using ActiveSheet.ListObjects(1).Range.AutoFilter

But now, everytime I filter and change something in the sheet, to selected filters become forgotten, which is pretty annoying. Is there a workaround for this behavior?

Kind regards

Private Sub Worksheet_Change(ByVal Target As Range)
    ' Filters LagerlisteHW Row B for the word "Selfservice" and copys the corresponding lines
    ' to the sheet "Selfservice" to rows with the headers deefined in Selfservice!A2:C2
    ' Define the search-criteria in Selfservice!L1:L2 (currently the word "Selfservice")


    Sheets("LagerlisteHW").Range("B5").CurrentRegion.AdvancedFilter Action:=xlFilterCopy, _
    CriteriaRange:=Sheets("Selfservice").Range("L1:L2"), CopyToRange:=Sheets("Selfservice").Range("A2:C2"), Unique:=False


    If ActiveSheet.AutoFilterMode = False Then
        ActiveSheet.ListObjects(1).Range.AutoFilter
    End If



    'Selection.AutoFilter    ' Enable the AutoFilter Mode


End Sub
braX
  • 11,506
  • 5
  • 20
  • 33
  • Does it have something to do with the autofilter not being additive? It overrides the current filter everytime a change happens – Michael Schmid Oct 19 '18 at 12:08

1 Answers1

1

You have to store the Autofilter and re-apply it after the run of the advanced filter. I used the code from here and split it into two subs. The code would look like that

Private Sub Worksheet_Change(ByVal Target As Range)
' Filters LagerlisteHW Row B for the word "Selfservice" and copys the corresponding lines
' to the sheet "Selfservice" to rows with the headers deefined in Selfservice!A2:C2
' Define the search-criteria in Selfservice!L1:L2 (currently the word "Selfservice")

Dim wks As Worksheet
Dim filterArray As Variant
Dim curFiltRange As String

    Set wks = Sheets("LagerlisteHW")
    StoreAutoFilter wks, filterArray, curFiltRange

    Sheets("LagerlisteHW").Range("B5").CurrentRegion.AdvancedFilter Action:=xlFilterCopy, _
                                                                    CriteriaRange:=Sheets("Selfservice").Range("L1:L2"), CopyToRange:=Sheets("Selfservice").Range("A2:C2"), Unique:=False


    If ActiveSheet.AutoFilterMode = False Then
        ActiveSheet.ListObjects(1).Range.AutoFilter
    End If

    RedoAutoFilter wks, filterArray, curFiltRange

    'Selection.AutoFilter    ' Enable the AutoFilter Mode

End Sub

Sub StoreAutoFilter(ByVal wks As Worksheet, ByRef filterArray As Variant, ByRef currentFiltRange As String)

    Dim col As Integer
    Dim f As Long

    ' Capture AutoFilter settings
    With wks.AutoFilter
        currentFiltRange = .Range.Address
        With .Filters
            ReDim filterArray(1 To .Count, 1 To 3)
            For f = 1 To .Count
                With .Item(f)
                    If .On Then
                        filterArray(f, 1) = .Criteria1
                        If .Operator Then
                            filterArray(f, 2) = .Operator
                            filterArray(f, 3) = .Criteria2 'simply delete this line to make it work in Excel 2010
                        End If
                    End If
                End With
            Next f
        End With
    End With

End Sub

Sub RedoAutoFilter(ByVal wks As Worksheet, ByVal filterArray As Variant, ByRef currentFiltRange As String)
Dim i As Long
Dim col As Integer

    ' Restore Filter settings
    For col = 1 To UBound(filterArray, 1)
        If Not IsEmpty(filterArray(col, 1)) Then
            If filterArray(col, 2) Then
                wks.Range(currentFiltRange).AutoFilter field:=col, _
                Criteria1:=filterArray(col, 1), _
                Operator:=filterArray(col, 2), _
                Criteria2:=filterArray(col, 3)
            Else
                wks.Range(currentFiltRange).AutoFilter field:=col, _
                Criteria1:=filterArray(col, 1)
            End If
        End If
    Next col

End Sub
Storax
  • 11,158
  • 3
  • 16
  • 33
  • Thank you very much. I'm fairly new to VB. Would you mind giving me a bit more explanation, e.g. comments? Furthermore it seems like `currentFilterRange = .Range.Address` throws some problems. But the VBA-compiler won't tell which. – Michael Schmid Oct 19 '18 at 14:13
  • For further details follow the link I provided. `currentFilterRange = .Range.Address`throws a run time error in case the last selection on your "LagerlisteHW" is outside of the autofilter area. You might want to use the improved version of the code I took from the link above, please look [here](https://stackoverflow.com/a/15379095/6600940) – Storax Oct 19 '18 at 14:26