Remove current cell's value from active autofilter in same column

Question

I have a big Excel sheet containing +100k rows and have an autofilter on one column of text values with category numbers and descriptions. There are thousands of different values in column F, so updating the autofilter is very impractical via using the standard UI.

How can I create a macro that removes the currently active cell's value from the autofilter that is active on the same column?

Answer 1

With the help of an expert, we came to a working solution for my case.
Just posting this as solution for others:

Sub Clear_Filter_and_Value()

Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim w As Worksheet
Dim filterArray()
Dim currentFiltRange As String
Dim col As Integer

Dim flag As Boolean

Set w = ActiveSheet
If w.AutoFilterMode = False Then Selection.AutoFilter
flag = False

On Error GoTo exit1

With w.AutoFilter
    currentFiltRange = .Range.Address
    With .Filters
        For f = 1 To .Count
            With .Item(f)
                If .On Then
                    If ActiveCell.Column = f Then
                        ReDim filterArray(1 To .Count)
                        If .Count = 2 Then
                            filterArray(1) = .Criteria1
                            filterArray(2) = .Criteria2
                        Else
                            filterArray(1) = .Criteria1
                        End If
                    End If
                ElseIf ActiveCell.Column = f Then
                    tR = Cells(Rows.Count, ActiveCell.Column).End(xlUp).Row
                    ReDim filterArray(1 To tR - 1)
                    For i = 2 To tR
                        filterArray(i - 1) = Cells(i, ActiveCell.Column).Value
                        flag = True
                    Next i
                End If
            End With
        Next f
    End With
End With

w.AutoFilterMode = False


j = 1
ReDim newArray(1 To UBound(filterArray))
If flag = False Then
    On Error GoTo 1
    For i = 1 To UBound(filterArray(1))
        On Error GoTo 1
        If InStr(1, filterArray(1)(i), ActiveCell.Value) = 0 Then
            newArray(j) = filterArray(1)(i)
            j = j + 1
        End If
    Next i
Else
1:
    Err.Clear
    For i = 1 To UBound(filterArray)
        If InStr(1, filterArray(i), ActiveCell.Value) = 0 Then
            newArray(j) = filterArray(i)
            j = j + 1
        End If
    Next i
End If

For col = 1 To 1
    If Not IsEmpty(filterArray(1)) Then
        w.Range(currentFiltRange).AutoFilter Field:=ActiveCell.Column,     Criteria1:=newArray, Operator:=xlFilterValues
    End If
Next col
exit1:
Application.ScreenUpdating = True
Application.DisplayAlerts = True


End Sub