AutoFilter items which are NOT in the list ( Not in the list Filter)

[jonnathanjons]

Hello Hans.

I need your expertise. I use below code to Auto Filter from another sheet named "FilterList" where I have to filter 15 k rows or more every month. I have 2 VBA scripts which I use for Autofilter . But now I have a requirement to Filter all items "NOT" in the list. You can use VBA Script 1 Or VBA Script2 . But I prefer 1 (if possible) because it runs faster. but not an issue with the script 2 if not possible with 1

In the script 2 i have created a line rng.AutoFilter Field:=e, Criteria1:="<>" & Criteria, Operator:=xlFilterValues to Filter items not in the list but its does not show any result.

I use ribbon button command from personal.xlsb I will use this as a separate button. Thanks as always.


VBA Script 1 <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

Code: Select all

Sub InverseFilter1()
Application.ScreenUpdating = False
    
    Const m = "MESSAGE", S = "FilterList"
            With Sheets
        If .Count > 1 Then
           '.Item(1).Activate
            If Selection.Column > ActiveSheet.UsedRange.Columns.Count Then Msgbox "Select a Column within the range { " & ActiveSheet.UsedRange.Cells.Address & " } to Filter !", 64, m _
                Else ActiveSheet.UsedRange.AutoFilter Selection.Column, Application.Transpose(Sheets("FilterList").UsedRange), 7
        Else
           '.add(, .Item(1)).Name = "FilterList"
            Msgbox "Add your search list in column A and proceed!!", 64, m
        End If
    End With
Application.ScreenUpdating = True
End Sub]

VBA Script 2 <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

I tried to add this line " 'rng.AutoFilter Field:=e, Criteria1:="<>" & Criteria, Operator:=xlFilterValues " at the bottom of the script where I commented out.

Code: Select all

Sub InverseFilter2 () 
Application.ScreenUpdating = False

Dim tempCriteria As Variant
Dim i As Long
Dim Criteria() As String
Dim rng As Range
Dim e As Integer
Dim FilterList As Worksheet
Dim ShtName As String
ShtName = "Filterlist"
Set rng = ActiveSheet.UsedRange
   
  
LastRow = Sheets("Filterlist").Cells(Rows.Count, 1).End(xlUp).Row
e = rng.Application.WorksheetFunction.Match(Selection, Range("1:1"), 0)

tempCriteria = Sheets("FilterList").Range("A1:A" & LastRow)

'tempCriteria = Worksheets("FilterList").Range("A1:A" & lastRow)

ReDim Criteria(1 To UBound(tempCriteria))

For i = 1 To UBound(tempCriteria)
    Criteria(i) = CStr(tempCriteria(i, 1))
Next
rng.AutoFilter field:=e, Criteria1:=Criteria, Operator:=xlFilterValues
'rng.AutoFilter Field:=e, Criteria1:="<>" & Criteria, Operator:=xlFilterValues   <<<< Need help here 
  
Application.ScreenUpdating = True
     
End Sub]

[HansV]

Would it be OK to populate some cells on the FilterList sheet?

[jonnathanjons]

Hi Hans,

I am not sure if I am following your query. Are you asking me to populate some examples in FilterList? I am attaching a test file. Sheet "Data" is the Autofilter function.Sheet2 "FilterList" is the list of item to filter. In sheet 3 & 4 I am attaching the VBA1 & VBA2. Its a long VBA. Sorry for that.
Basically what both the VBA does is
1) In the "Data" page it will autoFilter the Column User Select from the FilterList sheet .Just select the cell anywhere in the column where filter need to function.
2) In the FilterList Column B1 there will be a lookup with Data sheet and shows what are the items in the Filterlist that does not exist in the Data Sheet.

My New Requirement is

3) in the "Data" Sheet I would like to have a scrip that can Autofilter the items which are "NOT" in the FilterList Sheet. Only that portion of the script is required

[HansV]

I tried to filter using Advanced Filter, but I cannot get it to work. Sorry.

[p45cal]

I've made minimal changes to your FullFunction code to show you a way of doing this.
It creates a list of items to include in the filter by removing the ones that do match the filterlist, and uses that as the criteria for Autofilter.
The code needs tidying up. It should get you started.
This one also filters out blanks, but that's easily changed.

[jonnathanjons]

Hello Pascal,
Hope you are doing great. Thanks for helping me in this . Your code works wonderfully .I have few questions if I may.
in you code you have commented out this line 'Debug.Assert IsError(bbb). I was wondering should I uncomment it for any reason?
Also When I entered only 1 item in the FilterList this code is not working, but works for more than 1 item. For "Auto Filter from the list" and also "Filter Not in the list". May I know why ? Pls check the excel sheet attached. I used the last line as an example. It can be an issue in the original code. but I ignored it because for 1 Item I would do it manually but this function will be in need when the case is reversed.ie I need all list except this one. I hope you understand me.

[p45cal]

Again, just minimal tweaks to your existing code:

Code: Select all

Sub Fullfunction()
Dim tempCriteria As Variant
Dim i As Long
Dim rng As Range
Dim ShtName As String, LastRow As Long, e, AllExisting, myCount

'Application.ScreenUpdating = False
ShtName = "Filterlist"
Set rng = ActiveSheet.UsedRange
On Error Resume Next
If ActiveSheet.AutoFilterMode Then ActiveSheet.ShowAllData
On Error GoTo 0
Const m = "MESSAGE", S = "FilterList"
If Evaluate("ISREF('" & S & "'!A1)") Then
  With Sheets(S)
    If Application.CountA(.[A1].CurrentRegion.Columns(1)) Then
      ActiveSheet.Activate
      If Intersect(ActiveSheet.UsedRange.Rows(1), Selection(1)) Is Nothing Then
        MsgBox "Select the header name to filter !", 48, m: Exit Sub
      Else
        .[A1].CurrentRegion.Columns(2).Formula = "=IF(ISNUMBER(MATCH(A1," & ActiveSheet.UsedRange.Columns(Selection.Column).Address(, , , True) & ",0)),""."",""Not Exist"")"
        .[A1].CurrentRegion.Columns(2).Value = .[A1].CurrentRegion.Columns(2).Value
        .[A1].CurrentRegion.Columns.AutoFit
        '.Activate
      End If
    Else
      .Activate
      MsgBox "Column A is empty. Fill it!!!", 48, m
    End If
  End With
Else
  Sheets.Add(, Sheet1).Name = S
  MsgBox "Add your search list in column A and proceed!!", 64, m
End If
LastRow = Sheets("Filterlist").Cells(Rows.Count, 1).End(xlUp).Row
e = rng.Application.WorksheetFunction.Match(Selection, Range("1:1"), 0)
AllExisting = rng.Columns(e)
ReDim NewCriteria(1 To UBound(AllExisting))
If LastRow = 1 Then
  ReDim tempCriteria(1 To 1, 1 To 1)
  tempCriteria(1, 1) = Sheets("FilterList").Range("A1")
Else
  tempCriteria = Sheets("FilterList").Range("A1:A" & LastRow)
End If
ReDim Criteria(1 To UBound(tempCriteria))
myCount = 0
For i = 1 To UBound(AllExisting)
  If IsError(Application.Match(AllExisting(i, 1), tempCriteria, 0)) Then
    myCount = myCount + 1
    NewCriteria(myCount) = AllExisting(i, 1)
  End If
Next i
ReDim Preserve NewCriteria(1 To myCount)
rng.AutoFilter field:=e, Criteria1:=NewCriteria, Operator:=xlFilterValues
'Application.ScreenUpdating = True
End Sub

Debug.Assert line should remain commented or removed altogether. It's only there for development to stop the code when a condtion is (not) met.

[jonnathanjons]

Works great as expected.Thanks for your quick response and support.esp during the weekend. Have a great rest of the day.