use vba for filter if contains

kojy86

New Member
Joined
Jun 8, 2011
Messages
15
Hello ,
i'm using the following vba to make the raw no. 2 is the filter key (it means that any column will be auto filtered based on the value entered in raw no.2) i need to use the same but the filter will be based on (if contains) not (equal)
any help??

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rownum As Long, colnum As Long
Dim tblname As String, mylist As Object
Dim caret As Long, caret2 As Long
Dim crit1 As String, crit2 As String, optype As String, marker As String


'Set this next value to the row number above your filter
Const testrow = 2
'Change the marker to something other than the caret ^ if required
marker = "^"


On Error GoTo Worksheet_Change_Error


rownum = Target.Row
colnum = Target.Column
On Error Resume Next


If Target.Count > 1 Then
ActiveSheet.ShowAllData
Target.Interior.ColorIndex = -4142 'clear colour from range
GoTo cleanup
End If


If rownum <> testrow Then GoTo cleanup
crit1 = Target.Value
caret = InStr(Target, marker)
caret2 = InStr(Target, marker & marker)


If caret Then
crit1 = Trim(Left(Target.Value, caret - 1))
crit2 = WorksheetFunction.Substitute(Mid(Target.Value, caret + 1), marker, "")
optype = xlAnd
End If


If caret2 Then
optype = xlOr
End If


If Val(Application.Version) < 11 Then GoTo earlyversion


Set mylist = ActiveSheet.ListObjects
If mylist.Count Then ' A List or Table Object is used
tblname = mylist(1).Name

If Cells(rownum, colnum).Value = "" Then ' No filter choice
mylist(tblname).Range.AutoFilter Field:=colnum
GoTo cleanup
ElseIf caret Then
mylist(tblname).Range.AutoFilter Field:=colnum, _
Criteria1:=crit1, Operator:=optype, Criteria2:=crit2
GoTo cleanup
Else
mylist(tblname).Range.AutoFilter Field:=colnum, _
Criteria1:=crit1
GoTo cleanup
End If

' There is no List object, it is a Range so treat the same as
' earlier versions of Excel

End If


earlyversion:
'This version of Excel does not support List Objects
If Cells(rownum, colnum).Value = "" Then
Selection.AutoFilter Field:=colnum
ElseIf caret Then
Selection.AutoFilter Field:=colnum, _
Criteria1:=crit1, Operator:=optype, Criteria2:=crit2
Else
Selection.AutoFilter Field:=colnum, Criteria1:=crit1
End If


cleanup:
'keep focus on same cell and set colour index if Selection is made
'Hani Range(Target.Address).Activate
If ActiveCell <> "" Then
' ActiveCell.Interior.ColorIndex = 40 'change to colour of your choice
'Else
'ActiveCell.Interior.ColorIndex = -4142
End If




On Error GoTo 0
Exit Sub


Worksheet_Change_Error:


MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure Worksheet_Change of VBA Document Sheet4"
ActiveCell.Interior.ColorIndex = -4142
On Error GoTo 0
End Sub
 

Excel Facts

Shade all formula cells
To shade all formula cells: Home, Find & Select, Formulas to select all formulas. Then apply a light fill color.

Forum statistics

Threads
1,223,888
Messages
6,175,219
Members
452,620
Latest member
dsubash

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top