Hello everybody.
I am building a selection tool with a whole list of products. this excel list is filtering all the products based on the criteria. The criteria are:
Type
Height
Lengte
Watt D7:D30
But i have created a filter that is based on the type value in a cell. I have the following two problem.
- after typing the value i have to press enter for filtering, can this be done automatic?
- anf for the criteria watt I want that excel filter a range. for example: if i press the value "1000" i want that is filter from 985 to 1015
Who can help me with this problems?
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 = 6
'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
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
Bookmarks