I have a column with values like the below sample:
Size |
---|
4 |
1*4 |
1*24 |
4*1 |
4.5*10 |
2*14*5 |
3*4*5 |
I need to set a filter to get the cells contains the specific number e.g "4" ,
the expected results are (4 , 1*4 , 4*1 , 3*4*5
).
If I used wildcards "*4*
" as criteria then it will give me all values contains "4
" like (1*24 , 4.5*10
) and that not required.
the below code only find the cells that begins with my number:
Sub AutoFilter_on_number()
Dim ws As Worksheet, rng As Range
Const filterColumn As Long = 29 'column "AC"
Set ws = ActiveSheet
Set rng = ws.Range("A2:AH7000")
rng.AutoFilter Field:=filterColumn, Criteria1:="=4*", Operator:=xlFilterValues
End Sub
Sub AutoFilterOnNumber()
' Define constants.
Const F_COLUMN As Long = 29
Const F_CRITERION As String = "4"
Const F_DELIMITER As String = "*"
' Reference the table range.
Dim rg As Range
With ActiveSheet ' improve!
If .FilterMode Then .ShowAllData ' clear filters
If .AutoFilterMode Then .AutoFilterMode = False ' turn off auto filter
Set rg = .Range("A1").CurrentRegion
End With
' Write the values from the critical column of the range to an array.
Dim rCount As Long: rCount = rg.Rows.Count - 1
Dim Data():
Data = rg.Columns(F_COLUMN).Resize(rCount).Offset(1).Value
' Write the matching strings to the keys (a 1D array) of a dictionary.
' Define the dictionary.
Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
' Declare variables to be introduced in the For...Next loop.
Dim SubStrings() As String, r As Long, rStr As String
' Loop through the elements of the array.
For r = 1 To rCount
' Convert the current value to a string and store it in a variable.
rStr = Data(r, 1)
If Len(rStr) > 0 Then ' is not blank
' Split the string into an array.
SubStrings = Split(rStr, F_DELIMITER)
' Attempt to match the criterion in the split array.
If IsNumeric(Application.Match(F_CRITERION, SubStrings, 0)) Then
If Not dict.Exists(rStr) Then ' not in the dictionary
dict(rStr) = Empty
'Else ' already in the dictionary; do nothing
End If
'Else ' criterion not found, it's an error value; do nothing
End If
'Else ' is blank; do nothing
End If
Next r
' Filter the table range.
If dict.Count > 0 Then ' there are rows to be filtered
' Use the keys (a 1D array) of the dictionary
' with 'xlFilterValues' to filter the data.
rg.AutoFilter F_COLUMN, dict.Keys, xlFilterValues
'Else ' no rows to be filtered; do nothing
End If
End Sub