AutoFilter does NOT see numeric data in Filtered view (multiple values)
Worked on this AutoFiltering code for a while. It works as well as possible. If I use search criteria in Quotes replacing FilterCriteria it works every time. However, when trying to pass numbers to the FilterCriteria, it cannot find anything in my range (A: D ONLY!) Every time. It finds all text boxes in Colums E: G fine as they are all text. Columns A: D returns nothing. I've tried formatting A: D as text instead of numbers, and STILL doesn't see anything when filtering. An approximate range is shown, hopefully at the end.
Sub FindProduct()
'Note: This macro uses the function LastRow at end of Module
' Highly moded code from Ron de Bruin
'To define My_Range
Dim My_Range As Range
Dim CalcMode As Long
Dim ViewMode As Long
Dim CCount As Long
'To define New Sheet and Range
Dim WSNew As Worksheet
'Use for column and filter data selection
Dim FilterCriteria As String
Dim PickCol As String
'Set filter range on ActiveSheet
Set My_Range = Range("A1:G" & LastRow(ActiveSheet))
My_Range.Parent.Select
' ************************************
My_Range.Parent.AutoFilterMode = False
' Unprotect sheet, turn off AutoFilter, Show All
With ActiveSheet
.Unprotect
On Error Resume Next
.ShowAllData
End With
' Code to check if workbook is protected here. Redundant.
' ****************************************
'Turn off ScreenUpdating, Calculation, EnableEvents code here
' +++++++++++++++++++++++++++++++++++
' Use this to pick a Column to search and your FilterCriteria
PickCol = InputBox("What Column do you want to search in " & vbCrLf _
& "(A=1,B=2,C=3,D=4,E=5,F=6,G=7)?" _
& vbCrLf & vbCrLf, "Select Column to Search")
' Input error check
' ######################
FilterCriteria = InputBox("What are you looking for?" _
& vbCrLf & vbCrLf & "This will work with partial Information.", _
"Enter Filter Parameter")
' Input error check
' *********************************************************
' Insert PickCol and FilterCriteria variables
My_Range.AutoFilter Field:=PickCol, Criteria1:="=*" & FilterCriteria & "*"
'Check if there are not more then 8192 areas (limit of areas that Excel can copy)
CCount = 0
On Error Resume Next
CCount = My_Range.Columns(1).SpecialCells(xlCellTypeVisible).Areas(1).Cells.Count
On Error GoTo 0
If CCount = 0 Then
MsgBox "There are more than 8192 areas:" _
& vbCrLf & "It is not possible to copy the visible data."
Else
' ***********************************************
'Delete "Filtered Data" sheet if it exists code here
' ***********************************************
' ------------------------------
'Add a new Worksheet
Set WSNew = Worksheets.Add(After:=Sheets(ActiveSheet.Index))
On Error Resume Next
WSNew.Name = "Filtered Data"
' ------------------------------
' ///////////////////////////////////////////////////
'Copy/paste the visible data to the new worksheet
My_Range.Parent.AutoFilter.Range.Copy
' Paste copied range starting at Cell("A2")
With WSNew.Range("A2")
.PasteSpecial Paste:=8
.PasteSpecial xlPasteAll
.PasteSpecial xlPasteFormats
Application.CutCopyMode = False
.Select
End With
' ///////////////////////////////////////////////////
' *****************************************
'Adds Formatted Text to Cell ("A1") code here
' *****************************************
End If
' Turn off AutoFilter
My_Range.Parent.AutoFilterMode = False
' ******************************************************
'More finishing code here
' ******************************************************
End Sub
Function LastRow(Sh As Worksheet)
On Error Resume Next
LastRow = Sh.Cells.Find(What:="*", _
After:=Sh.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlValues, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function
Sample data:
A B C D E F G
Date Rvd Qty File# P.O.# Cust Name Vend Name Carrier
02/14/15 210 41680 38565 Some Tech John DHL
03/08/15 458 17017 38569 Them Guys Donn Fedx
03/12/15 350 16736 38541 Some Guys Teri UPS
03/24/15 236 42630 38655 Some Tech John DHL
04/08/15 458 56985 85693 Them Guys Donn Fedx
04/12/15 350 12345 43851 Some Guys Teri UPS
04/18/15 838 56685 85693 Them Guys Donn Fedx
05/05/15 110 13245 43851 Some Guys Teri UPS
For whatever reason, when it runs AutoFilter using any numbers for A: D, it cannot filter the data. I'm stumped as I said it will return filtered data IF I put the exact value I want in the AutoFilter string.
Pretty sure this line is my problem / problem: Field My_Range.AutoFilter: = PickCol, Criteria1: = "=" and FilterCriteria and ""
Any ideas?
I guess now I need to figure out how to actually make this work. Using Autofilter correctly on a sheet it works great. If I need to do what I think, the article shows that I have to add 4 more columns and I need to rewrite the SaveLog code in the form that generates this list. It looks like I need to significantly increase the size of my code for everything. For newbies like me, I am definitely overwhelmed at this point.
source to share
It's not pretty, I'm sure there are tons of room to improve this code, but this is what I'm going to use. I Dimmed "FilterCriteria" as "Option" and replaced the single line immediately after InputBoxes "PickCol" and "FilterCriteria" with the following Select-Case procedure:
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' Determines whether "FilterCriteria" is Date, Numerical or text input
Select Case PickCol
Case 1
' "PickCol" - Column "A" (1) is Date
' Define for Numeric
My_Range.AutoFilter Field:=PickCol, Criteria1:=FilterCriteria
Case 2 To 4
' "PickCol" - Column "B:D" (2-4) Are Numerical
' Define for Numeric
My_Range.AutoFilter Field:=PickCol, Criteria1:=FilterCriteria
' This column CAN have mixed Numeric and Text data. So-> Evaluate that
If IsNumeric(FilterCriteria) Then
' Define for Numeric
My_Range.AutoFilter Field:=PickCol, Criteria1:=FilterCriteria
Else
' Redefine for Text instead
My_Range.AutoFilter Field:=PickCol, Criteria1:="=*" & FilterCriteria & "*"
End If
Case Else
' "PickCol" - Column "E:G" (5-7) Are Text
' Define for Text
My_Range.AutoFilter Field:=PickCol, Criteria1:="=*" & FilterCriteria & "*"
End Select
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
As I already said. "It may not be pretty, but it works."
Thanks for the tip @Byron
This allows wildcards (partial) to be entered in E: G, although A: D MUST be exactly the same as specified. I still have to catch errors for non-existent data that was entered or it crashes. This is one small step up from the rest. Another cookie for me at work. Good because I'm hungry. Lol
source to share
The core of this problem is that you cannot use text-to-number comparison operators. When you add wildcards *
to your search criteria, you are performing text comparisons.
If you want this to work with numbers and text and have a variable column selection, you will need to add some checks to build the criteria correctly. This will drop the number *
when the column is selected. The main thing to keep in mind is that each data type has only certain filters available for it. To check them, click the arrow on the normal filter menu to see what is listed under Number Filters
either Date Filters
or Text Filters
.
With all this in mind , if you want to filter those numeric columns by Contains
, you will need to convert it to text.
In a comment from @Tim Williams, you can convert your numbers to text using the function Data->Text to Columns
. You can automate this step with VBA if you know which ranges need to be converted.
The minimum number of parameters required for work looks like DataType
and FieldInfo
. FieldInfo
is essential for a forced conversion.
Sub ConvertColumnNumberToText()
Dim rng_column As Range
For Each rng_column In Range("B:D").Columns
rng_column.TextToColumns DataType:=xlDelimited, FieldInfo:=Array(1, 2)
Next rng_column
End Sub
Check the TextToColumns documentation to see what the options are. It will only run one column at a time, hence the loop.
Also, there is little harm in running this code multiple times as long as it only works with numbered columns. If you accidentally run it on a column that can be split into columns (contains by default TAB
), you will start overwriting other columns.
source to share