Set Auto Filtering multiple wildcards - vba

Right now I am doing coding to set a filter for a data chart. Basically, I don't know how to post the data sheet up here so just try to type them ):
(starting from the left is column A)
Name * BDevice * Quantity * Sale* Owner
Basically I need to filter out for 2 column:
-The BDevice with any word contain "M1454" or "M1467" or "M1879" (It means that M1454A or M1467TR would still fit in)
-The Owner with PROD or RISK
Here is the code I wrote:
Sub AutoFilter()
ActiveWorkbook.ActiveSheet..Range(B:B).Select
Selection.Autofilter Field:=1 Criteria1:=Array( _
"*M1454*", "*M1467*", "*M1879*"), Operator:=xlFilterValues
Selection.AutoFilter Field:=4 Criteria1:="=PROD" _
, Operator:=xlOr, Criteria2:="=RISK"
End Sub
When I run the code, the machine returns error 1004 and the part which seems to be wrong is the Filter part 2 ( I am not sure about the use of Field, so I can not say it for sure)
Edit; Santosh: When I try your code, the machine gets error 9 subscript out of range. The error came from the with statement. (since the data table has A to AS column so I just change to A:AS)

While there is a maximum of two direct wildcards per field in the AutoFilter method, pattern matching can be used to create an array that replaces the wildcards with the Operator:=xlFilterValues option. A Select Case statement helps the wildcard matching.
The second field is a simple Criteria1 and Criteria2 direct match with a Operator:=xlOr joining the two criteria.
Sub multiWildcardFilter()
Dim a As Long, aARRs As Variant, dVALs As Object
Set dVALs = CreateObject("Scripting.Dictionary")
dVALs.CompareMode = vbTextCompare
With Worksheets("Sheet1")
If .AutoFilterMode Then .AutoFilterMode = False
With .Cells(1, 1).CurrentRegion
'build a dictionary so the keys can be used as the array filter
aARRs = .Columns(2).Cells.Value2
For a = LBound(aARRs, 1) + 1 To UBound(aARRs, 1)
Select Case True
Case aARRs(a, 1) Like "MK1454*"
dVALs.Add Key:=aARRs(a, 1), Item:=aARRs(a, 1)
Case aARRs(a, 1) Like "MK1467*"
dVALs.Add Key:=aARRs(a, 1), Item:=aARRs(a, 1)
Case aARRs(a, 1) Like "MK1879*"
dVALs.Add Key:=aARRs(a, 1), Item:=aARRs(a, 1)
Case Else
'no match. do nothing
End Select
Next a
'filter on column B if dictionary keys exist
If CBool(dVALs.Count) Then _
.AutoFilter Field:=2, Criteria1:=dVALs.keys, _
Operator:=xlFilterValues, VisibleDropDown:=False
'filter on column E
.AutoFilter Field:=5, Criteria1:="PROD", Operator:=xlOr, _
Criteria2:="RISK", VisibleDropDown:=False
'data is filtered on MK1454*, MK1467* or MK1879* (column B)
'column E is either PROD or RISK
'Perform work on filtered data here
End With
If .AutoFilterMode Then .AutoFilterMode = False
End With
dVALs.RemoveAll: Set dVALs = Nothing
End Sub
If exclusions¹ are to be added to the filtering, their logic should be placed at the top of the Select.. End Select statement in order that they are not added through a false positive to other matching criteria.
                                Before applying AutoFilter Method
                                After applying AutoFilter w/ multiple wildcards
¹ See Can Advanced Filter criteria be in the VBA rather than a range? and Can AutoFilter take both inclusive and non-inclusive wildcards from Dictionary keys? for more on adding exclusions to the dictionary's filter set.

For using partial strings to exclude rows and include blanks you should use
'From Jeeped's code
Dim dVals As Scripting.Dictionary
Set dVals = CreateObject("Scripting.Dictionary")
dVals.CompareMode = vbTextCompare
Dim col3() As Variant
Dim col3init As Integer
'Swallow row3 into an array; start from 1 so it corresponds to row
For col3init = 1 to Sheets("Sheet1").UsedRange.Rows.count
col3(col3init) = Sheets("Sheet1").Range(Cells(col3init,3),Cells(col3init,3)).Value
Next col3init
Dim excludeArray() As Variant
'Partial strings in below array will be checked against rows
excludeArray = Array("MK1", "MK2", "MK3")
Dim col3check As Integer
Dim excludecheck as Integer
Dim violations As Integer
For col3check = 1 to UBound(col3)
For excludecheck = 0 to UBound(excludeArray)
If Instr(1,col3(col3check),excludeArray(excludecheck)) <> 0 Then
violations = violations + 1
'Sometimes the partial string you're filtering out for may appear more than once.
End If
Next col3check
If violations = 0 and Not dVals.Exists(col3(col3check)) Then
dVals.Add Key:=col3(col3check), Item:=col3(col3check) 'adds keys for items where the partial strings in excludeArray do NOT appear
ElseIf col3(col3check) = "" Then
dVals.Item(Chr(61)) = Chr(61) 'blanks
End If
violations = 0
Next col3check
The dVals.Item(Chr(61)) = Chr(61) idea came from Jeeped's other answer here
Multiple Filter Criteria for blanks and numbers using wildcard on same field just doesn't work

Try below code :
max 2 wildcard expression for Criteria1 works. Refer this link
Sub AutoFilter()
With ThisWorkbook.Sheets("sheet1").Range("A:E")
.AutoFilter Field:=2, Criteria1:=Array("*M1454*", "*M1467*"), Operator:=xlFilterValues
.AutoFilter Field:=5, Criteria1:="=PROD", Operator:=xlOr, Criteria2:="=RISK"
End With
End Sub

Related

How to make multiple filter values invisible in Excel Vba [duplicate]

In the continuing saga of my data analysis (First Question), I want to delete all the rows whose departments (Field 7) are not 101, 102 or 103 (the names have been changed to protect the innocent). There are about a hundred departments in the data, so using Criteria1:=Array("104", "105", "106", etc is impractical.
I would like to do something like this:
myrange.AutoFilter Field:=7, Criteria1:="<>101", Operator:=xlOr, _
Criteria2:="<>102", Operator:=xlOr, Criteria3:="<>103"
but Excel doesn't recognize more than 2 Criteria. I could add a helper column, and have the macro run through each line (if 101, 102, or 103, then value=Yes), filter out the yeses, and delete all that remain, but I'm saving that as a last resort.
Is there a way to Autofilter Criteria1 to be Not Equal To an array? Something like:
myrange.AutoFilter Field:=7, Criteria1:="<>" & Array("101", "102", "103")
Remember the goal is to delete the non-matching rows; AutoFilter is only one tool to help achieve the goal. If AutoFilter does not meet your needs, pick another method. Consider:
Sub AllBut()
Dim rTable As Range, r As Range
Dim rDelete As Range
Set rTable = Selection
Set rDelete = Nothing
For Each r In rTable.Columns(7).Cells
v = r.Value
If v <> "101" And v <> "102" And v <> "103" Then
If rDelete Is Nothing Then
Set rDelete = r
Else
Set rDelete = Union(r, rDelete)
End If
End If
Next
If Not rDelete Is Nothing Then rDelete.EntireRow.Delete
End Sub
Here we select the block of data to be processed (not including the header row). The macro sweeps down column #7 of that block and deletes any row that does not match the criteria.
All that will remain are the 101's, the 102's, and the 103's.
Since this was about the AutoFilter method, I'll offer up this method involving using a Scripting.Dictionary object to mimic the procedure that would be used if this was manually performed on the worksheet.
On the worksheet, the user would apply an AutoFilter then use column G's drop down to 'turn off' the 101, 102 and 103 values. What remained would be be deleted. In VBA, we can grab all of column G and populate a dictionary object with the values that are not 101, 102 or 103 and use that as the criteria for the filter operation.
Sub filterNotThree()
Dim d As Long, dDELs As Object, vVALs As Variant
Set dDELs = CreateObject("Scripting.Dictionary")
With Worksheets("Sheet6")
If .AutoFilterMode Then .AutoFilterMode = False
With .Cells(1, 1).CurrentRegion
'grab all of column G (minus the header) into a variant array
vVALs = .Resize(.Rows.Count - 1, 1).Offset(1, 6).Value2
'populate the dictionary object with the values that are NOT 101, 102, or 103
For d = LBound(vVALs, 1) To UBound(vVALs, 1)
Select Case vVALs(d, 1)
Case 101, 102, 103
'do not add
Case Else
'not a match, add it to the delete list
'the AutoFilter criteria needs to be text
' so we set the Keys as text and the Items as numbers
dDELs.Item(CStr(vVALs(d, 1))) = vVALs(d, 1)
End Select
Next d
'check to make sure there is something to filter on
If CBool(dDELs.Count) Then
'filter on the dictionary keys
.AutoFilter field:=7, Criteria1:=dDELs.keys, Operator:=xlFilterValues
'delete the visible rows (there has to be some)
.Resize(.Rows.Count - 1, .Columns.Count).Offset(1, 0).EntireRow.Delete
End If
End With
If .AutoFilterMode Then .AutoFilterMode = False
End With
dDELs.RemoveAll: Set dDELs = Nothing
End Sub
                        Data before filterNotThree sub procedure
                        Data after filterNotThree sub procedure
I was doing something similar but for two fields and this syntax worked for me:
myrange.AutoFilter Field:=7, Criteria1:="<>101", Operator:=xlAnd, Criteria2:="<>102", Operator:=xlAnd
Hope it helps.
I know this is late but if you need more than 2 criteria, you have to use an array.
myrange.AutoFilter Field:=7, Criteria1:=Array("<>101", "<>102", "<>103"), Operator:=xlFilterValues

Count selected rows after auto filter

When my data are raw and unfiltered I can select them and Selection.Rows.Count returns the valid number.
After the AutoFilter it returns a number as if I selected the rows that were not visible, even though Selection.Copy does not copy other than selected rows.
How do I get the valid count of selected rows?
I tried Selection.SpecialCells(xlCellTypeVisible).Rows.Count.
EDIT
I use filter in another macro and then select by hand rows I want to add to another sheet.
I did two buttons, one to filter my table and the second to move selected rows to another sheet.
Sub ajout_commande()
Set DataSheet = ThisWorkbook.Worksheets("Prepa Commandes")
Dim a As Range, b As Range
Set a = Selection
i = 0
s = Selection.SpecialCells(xlCellTypeVisible).Count
For Each b In a.Rows
i = i + 1
DataSheet.Cells(6, 1).EntireRow.Insert
DataSheet.Range("A1:Z1").Copy DataSheet.Cells(6, 1).EntireRow
Next
Dim r1 As Range, r2 As Range, r3 As Range
Let copyrange1 = "E1" & ":" & "I" & i
Let copyrange2 = "BK1" & ":" & "BM" & i
Set r1 = a.Range(copyrange1)
Set r2 = a.Range(copyrange2)
Set r3 = Union(r1, r2)
r3.Copy
DataSheet.Cells(6, 1).PasteSpecial xlPasteValues
MsgBox s & " and " & i
End Sub
Here my table is filtered and I want to add selected rows to another sheet but the Selection.Rows.Count returns more rows than I selected because it counts the non visible rows, even though Selection.copy works.
For this example Selection.Rows.Count = 28 because of non visible rows between rows 10 and 20, 21 and 25 etc.
Is there a function to get the number I want (on this image 16)?
It depends on how you are using it. This works just fine for me
'~~> Remove any filters
ActiveSheet.AutoFilterMode = False
'~~> Specifying the complete address is the key part
With Range("A1:C6") '<~~ Filter, offset(to exclude headers)
.AutoFilter Field:=YOURFIELDNUMBER, Criteria1:=YOURCRITERIA
Debug.Print .Offset(1, 0).SpecialCells(xlCellTypeVisible).Rows.Count
End With
'~~> Remove any filters
ActiveSheet.AutoFilterMode = False
Test
Sub Sample()
'~~> Remove any filters
ActiveSheet.AutoFilterMode = False
With Range("A1:C6") '<~~ Filter, offset(to exclude headers)
.AutoFilter Field:=1, Criteria1:="Sid"
MsgBox .Offset(1, 0).SpecialCells(xlCellTypeVisible).Rows.Count
End With
'~~> Remove any filters
ActiveSheet.AutoFilterMode = False
End Sub
Well, the following would work if your selection was contiguous:
Selection.Columns(1).SpecialCells(xlCellTypeVisible).Count
However, from your screenshot I can see that your selections may be non-contiguous ranges (aka multiple areas selected), so you can use this function I created as a starting point:
Function countVisibleSelectedRows()
Dim count As Integer
count = 0
For Each Area In Selection.Areas
count = count + Area.Columns(1).SpecialCells(xlCellTypeVisible).count
Next
countVisibleSelectedRows = count
End Function
When you have multiple ranges selected, Excel calls each of those ranges an "area". In this function, we loop over each "area" in the Selection.Areas collection.
I know this is a late post to this question, but maybe this will help someone in the future. I find the following code snippet works well to count the number of visible rows in a range after being filtered.
Sub CountVisibleRows()
'only count the visible rows in the range
Dim lRow As Long, vis_lr As Long, DstWs As Worksheet
Set DstWs = ActiveSheet
lRow = DstWs.UsedRange.Rows.Count
'vis_lr = DstWs.Range("B2:B" & lRow).SpecialCells(xlCellTypeVisible).Count 'doesn't seem to work with non-contiguous rows
With DstWs
vis_lr = Application.WorksheetFunction.Subtotal(3, Range("B2:B" & lRow))
End With
Debug.Print vis_lr
End Sub

How to use autofilter for more than 2 criteria in Excel VBA [duplicate]

I need to filter a range with multiple criteria with operator Contains
The following code works very well (2 critera):
shData.UsedRange.AutoFilter field:=2, Criteria1:=Array("*a*", "*b*"), Operator:=xlFilterValues
But, not sure why the below code doesn't work (more than 2 criteria):
shData.UsedRange.AutoFilter field:=2, Criteria1:=Array("*a*", "*b*", "*c*"), Operator:=xlFilterValues
It's a limitation of autofilters. You can't use more than two contains filters in the UI either.
You can either use an Advanced filter instead, or you can create an array of the values that match your criteria and filter using that:
Sub MultiContainsAutofilter()
Dim vData
Dim shData As Worksheet
Dim d As Object
Dim i As Long
Set shData = ActiveSheet
vData = shData.UsedRange.Columns(2)
Set d = CreateObject("Scripting.Dictionary")
For i = LBound(vData, 1) To UBound(vData, 1)
If UCase$(vData(i, 1)) Like "*A*" Or UCase$(vData(i, 1)) Like "*B*" Or UCase$(vData(i, 1)) Like "*C*" Then
d(vData(i, 1)) = Empty
End If
Next i
If d.Count > 0 Then shData.UsedRange.AutoFilter Field:=2, Criteria1:=d.keys, Operator:=xlFilterValues
End Sub

Can Advanced Filter criteria be in the VBA rather than a range?

After trying in vain to set more than 2 criteria in a normal AutoFilter fashion via VBA, I have come to learn that it must be done via advanced filter.
offending example:
Worksheets(1).Range("A1").AutoFilter Field:=ColNum, Criteria1:="A*", Operator:=xlOr, Criteria2:="B*", Operator:=xlOr, Criteria3:="C*"
I am hoping to pass the criteria through to a function (rather than a macro) from a PowerShell script. I have it all working fine and as expected for 1 criteria, but now I'd like 3.
I suppose I could instead write a macro to insert a new sheet, write in the criteria then filter on that new range but I'd rather check the preferred way first.
To filter on multiple wildcards, create a variant array of wildcard matches and then use the array of full values with the standard AutoFilter method. You can minimize the array by putting a dictionary object to use with its unique index property.
Consider the following sample data.
      
Run this code.
Sub multiWildcards()
Dim v As Long, vVALs As Variant, dVALs As Object
Dim colNum As Long
Set dVALs = CreateObject("Scripting.Dictionary")
dVALs.comparemode = vbTextCompare
colNum = 2 'column B
With Worksheets(1)
If .AutoFilterMode Then .AutoFilterMode = False
With .Cells(1, 1).CurrentRegion
vVALs = .Columns(colNum).Cells.Value2
For v = LBound(vVALs, 1) To UBound(vVALs, 1)
If Not dVALs.exists(vVALs(v, 1)) Then
Select Case UCase(Left(vVALs(v, 1), 1))
Case "A", "B", "C"
dVALs.Add Key:=vVALs(v, 1), Item:=vVALs(v, 1)
Case Else
'do nothing
End Select
End If
Next v
If CBool(dVALs.Count) Then
'populated the dictionary; now use the keys
.AutoFilter Field:=colNum, Criteria1:=dVALs.keys, Operator:=xlFilterValues
Else
Debug.Print "Nothing to filter on; dictionary is empty"
End If
'.CurrentRegion is now filtered on A*, B*, C* in column B
'do something with it
End With
End With
dVALs.RemoveAll: Set dVALs = Nothing
End Sub
Results should be:
      
These results can be duplicated with many other wildcard scenarios. The Select Case statement is ideal as it supports the Like keyword for building your collection of matches. By starting with a value dump into a regular variant array, cycling through even large rows of data can be done quickly.

Excel VBA Autofilter contains with multiple criteria

I need to filter a range with multiple criteria with operator Contains
The following code works very well (2 critera):
shData.UsedRange.AutoFilter field:=2, Criteria1:=Array("*a*", "*b*"), Operator:=xlFilterValues
But, not sure why the below code doesn't work (more than 2 criteria):
shData.UsedRange.AutoFilter field:=2, Criteria1:=Array("*a*", "*b*", "*c*"), Operator:=xlFilterValues
It's a limitation of autofilters. You can't use more than two contains filters in the UI either.
You can either use an Advanced filter instead, or you can create an array of the values that match your criteria and filter using that:
Sub MultiContainsAutofilter()
Dim vData
Dim shData As Worksheet
Dim d As Object
Dim i As Long
Set shData = ActiveSheet
vData = shData.UsedRange.Columns(2)
Set d = CreateObject("Scripting.Dictionary")
For i = LBound(vData, 1) To UBound(vData, 1)
If UCase$(vData(i, 1)) Like "*A*" Or UCase$(vData(i, 1)) Like "*B*" Or UCase$(vData(i, 1)) Like "*C*" Then
d(vData(i, 1)) = Empty
End If
Next i
If d.Count > 0 Then shData.UsedRange.AutoFilter Field:=2, Criteria1:=d.keys, Operator:=xlFilterValues
End Sub