I have 8 variables in column A, 1,2,3,4,5 and A, B, C.
My aim is to filter out A, B, C and display only 1-5.
I can do this using the following code:
My_Range.AutoFilter Field:=1, Criteria1:=Array("1", "2", "3","4","5"), _
Operator:=xlFilterValues
But what the code does is it filters variables 1 to 5 and displays them.
I want to do the opposite, but yielding the same result, by filtering out A, B, C and showing variables 1 to 5
I tried this code:
My_Range.AutoFilter Field:=1, Criteria1:=Array("<>A", "<>B", "<>C"), _
Operator:=xlFilterValues
But it did not work.
Why cant I use this code ?
It gives this error:
Run time error 1004 autofilter method of range class failed
How can I perform this?
This question is related to
excel
vba
excel-2010
excel-2007
Alternative using VBA's Filter function
As an innovative alternative to @schlebe 's recent answer, I tried to use the Filter
function integrated in VBA, which allows to filter out a given search string setting the third argument to False. All "negative" search strings (e.g. A, B, C) are defined in an array. I read the criteria in column A to a datafield array and basicly execute a subsequent filtering (A - C) to filter these items out.
Code
Sub FilterOut()
Dim ws As Worksheet
Dim rng As Range, i As Integer, n As Long, v As Variant
' 1) define strings to be filtered out in array
Dim a() ' declare as array
a = Array("A", "B", "C") ' << filter out values
' 2) define your sheetname and range (e.g. criteria in column A)
Set ws = ThisWorkbook.Worksheets("FilterOut")
n = ws.Range("A" & ws.Rows.Count).End(xlUp).row
Set rng = ws.Range("A2:A" & n)
' 3) hide complete range rows temporarily
rng.EntireRow.Hidden = True
' 4) set range to a variant 2-dim datafield array
v = rng
' 5) code array items by appending row numbers
For i = 1 To UBound(v): v(i, 1) = v(i, 1) & "#" & i + 1: Next i
' 6) transform to 1-dim array and FILTER OUT the first search string, e.g. "A"
v = Filter(Application.Transpose(Application.Index(v, 0, 1)), a(0), False, False)
' 7) filter out each subsequent search string, i.e. "B" and "C"
For i = 1 To UBound(a): v = Filter(v, a(i), False, False): Next i
' 8) get coded row numbers via split function and unhide valid rows
For i = LBound(v) To UBound(v)
ws.Range("A" & Split(v(i) & "#", "#")(1)).EntireRow.Hidden = False
Next i
End Sub
An option using AutoFilter
Option Explicit
Public Sub FilterOutMultiple()
Dim ws As Worksheet, filterOut As Variant, toHide As Range
Set ws = ActiveSheet
If Application.WorksheetFunction.CountA(ws.Cells) = 0 Then Exit Sub 'Empty sheet
filterOut = Split("A B C D E F G")
Application.ScreenUpdating = False
With ws.UsedRange.Columns("A")
If ws.FilterMode Then .AutoFilter
.AutoFilter Field:=1, Criteria1:=filterOut, Operator:=xlFilterValues
With .SpecialCells(xlCellTypeVisible)
If .CountLarge > 1 Then Set toHide = .Cells 'Remember unwanted (A, B, and C)
End With
.AutoFilter
If Not toHide Is Nothing Then
toHide.Rows.Hidden = True 'Hide unwanted (A, B, and C)
.Cells(1).Rows.Hidden = False 'Unhide header
End If
End With
Application.ScreenUpdating = True
End Sub
Here an option using a list written on some range, populating an array that will be fiiltered. The information will be erased then the columns sorted.
Sub Filter_Out_Values()
'Automation to remove some codes from the list
Dim ws, ws1 As Worksheet
Dim myArray() As Variant
Dim x, lastrow As Long
Dim cell As Range
Set ws = Worksheets("List")
Set ws1 = Worksheets(8)
lastrow = ws.Cells(Application.Rows.Count, 1).End(xlUp).Row
'Go through the list of codes to exclude
For Each cell In ws.Range("A2:A" & lastrow)
If cell.Offset(0, 2).Value = "X" Then 'If the Code is associated with "X"
ReDim Preserve myArray(x) 'Initiate array
myArray(x) = CStr(cell.Value) 'Populate the array with the code
x = x + 1 'Increase array capacity
ReDim Preserve myArray(x) 'Redim array
End If
Next cell
lastrow = ws1.Cells(Application.Rows.Count, 1).End(xlUp).Row
ws1.Range("C2:C" & lastrow).AutoFilter field:=3, Criteria1:=myArray, Operator:=xlFilterValues
ws1.Range("A2:Z" & lastrow).SpecialCells(xlCellTypeVisible).ClearContents
ws1.Range("A2:Z" & lastrow).AutoFilter field:=3
'Sort columns
lastrow = ws1.Cells(Application.Rows.Count, 1).End(xlUp).Row
'Sort with 2 criteria
With ws1.Range("A1:Z" & lastrow)
.Resize(lastrow).Sort _
key1:=ws1.Columns("B"), order1:=xlAscending, DataOption1:=xlSortNormal, _
key2:=ws1.Columns("D"), order1:=xlAscending, DataOption1:=xlSortNormal, _
Header:=xlYes, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod:=xlPinYin
End With
End Sub
I don't have found any solution on Internet, so I have implemented one.
The Autofilter code with criteria is then
iColNumber = 1
Dim aFilterValueArray() As Variant
Call ConstructFilterValueArray(aFilterValueArray, iColNumber, Array("A", "B", "C"))
ActiveSheet.range(sRange).AutoFilter Field:=iColNumber _
, Criteria1:=aFilterValueArray _
, Operator:=xlFilterValues
In fact, the ConstructFilterValueArray() method (not function) get all distinct values that it found in a specific column and remove all values present in last argument.
The VBA code of this method is
'************************************************************
'* ConstructFilterValueArray()
'************************************************************
Sub ConstructFilterValueArray(a() As Variant, iCol As Integer, aRemoveArray As Variant)
Dim aValue As New Collection
Call GetDistinctColumnValue(aValue, iCol)
Call RemoveValueList(aValue, aRemoveArray)
Call CollectionToArray(a, aValue)
End Sub
'************************************************************
'* GetDistinctColumnValue()
'************************************************************
Sub GetDistinctColumnValue(ByRef aValue As Collection, iCol As Integer)
Dim sValue As String
iEmptyValueCount = 0
iLastRow = ActiveSheet.UsedRange.Rows.Count
Dim oSheet: Set oSheet = Sheets("X")
Sheets("Data")
.range(Cells(1, iCol), Cells(iLastRow, iCol)) _
.AdvancedFilter Action:=xlFilterCopy _
, CopyToRange:=oSheet.range("A1") _
, Unique:=True
iRow = 2
Do While True
sValue = Trim(oSheet.Cells(iRow, 1))
If sValue = "" Then
If iEmptyValueCount > 0 Then
Exit Do
End If
iEmptyValueCount = iEmptyValueCount + 1
End If
aValue.Add sValue
iRow = iRow + 1
Loop
End Sub
'************************************************************
'* RemoveValueList()
'************************************************************
Sub RemoveValueList(ByRef aValue As Collection, aRemoveArray As Variant)
For i = LBound(aRemoveArray) To UBound(aRemoveArray)
sValue = aRemoveArray(i)
iMax = aValue.Count
For j = iMax To 0 Step -1
If aValue(j) = sValue Then
aValue.Remove (j)
Exit For
End If
Next j
Next i
End Sub
'************************************************************
'* CollectionToArray()
'************************************************************
Sub CollectionToArray(a() As Variant, c As Collection)
iSize = c.Count - 1
ReDim a(iSize)
For i = 0 To iSize
a(i) = c.Item(i + 1)
Next
End Sub
This code can certainly be improved in returning an Array of String but working with Array in VBA is not easy.
CAUTION: this code work only if you define a sheet named X because CopyToRange parameter used in AdvancedFilter() need an Excel Range !
It's a shame that Microfsoft doesn't have implemented this solution in adding simply a new enum as xlNotFilterValues ! ... or xlRegexMatch !
This works for me:
This is a criteria over two fields/columns (9 and 10), this filters rows with values >0 on column 9 and rows with values 4, 7, and 8 on column 10. lastrow
is the number of rows on the data section.
ActiveSheet.Range("$A$1:$O$" & lastrow).AutoFilter Field:=9, Criteria1:=">0", Operator:=xlAnd
ActiveSheet.Range("$A$1:$O$" & lastrow).AutoFilter Field:=10, Criteria1:=Arr("4","7","8"), Operator:=xlFilterValues
Replace Operator:=xlOr with Operator:=xlAnd between your criteria. See below the amended script
myRange.AutoFilter Field:=1, Criteria1:="<>A", Operator:=xlAnd, Criteria2:="<>B", Operator:=xlAnd, Criteria3:="<>C"
Source: Stackoverflow.com