+ Reply to Thread
Results 1 to 6 of 6

Building a selection tool - problem with the range

Hybrid View

japie123 Building a selection tool -... 09-09-2014, 04:53 AM
JBeaucaire Re: Building a selection tool... 09-09-2014, 07:50 AM
japie123 Re: Building a selection tool... 09-09-2014, 07:59 AM
JBeaucaire Re: Building a selection tool... 09-09-2014, 08:29 AM
japie123 Re: Building a selection tool... 09-09-2014, 09:52 AM
JBeaucaire Re: Building a selection tool... 09-09-2014, 10:39 AM
  1. #1
    Registered User
    Join Date
    09-09-2014
    Location
    England
    MS-Off Ver
    2010
    Posts
    7

    Building a selection tool - problem with the range

    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

  2. #2
    Forum Expert JBeaucaire's Avatar
    Join Date
    03-21-2004
    Location
    Bakersfield, CA
    MS-Off Ver
    2010, 2016, Office 365
    Posts
    33,492

    Re: Building a selection tool - problem with the range

    1) A worksheet_change event requires a physical change to occur in a cell on the sheet for it to trigger, so no, you can't skip pressing ENTER.

    2) What part of your code handles the "watt" filter? Your variables don't make it clear which what they are for, I try to use variable names that hint at what they are for later in the code.
    _________________
    Microsoft MVP 2010 - Excel
    Visit: Jerry Beaucaire's Excel Files & Macros

    If you've been given good help, use the icon below to give reputation feedback, it is appreciated.
    Always put your code between code tags. [CODE] your code here [/CODE]

    ?None of us is as good as all of us? - Ray Kroc
    ?Actually, I *am* a rocket scientist.? - JB (little ones count!)

  3. #3
    Registered User
    Join Date
    09-09-2014
    Location
    England
    MS-Off Ver
    2010
    Posts
    7

    Re: Building a selection tool - problem with the range

    I have already a other solutions. i am now using this code:

    Private Sub Worksheet_Change(ByVal Target As Range)
        If Not Intersect(Target, Range("A5:F5")) Is Nothing Then
            Select Case Target.Address
                Case Is = "$A$5"
                    If Range("A5").Value = "" Then
                        Range("A6:F37").AutoFilter Field:=1
                    Else
                        Range("A6:F37").AutoFilter Field:=1, _
                            Criteria1:=Range("A5").Value
                    End If
                Case Is = "$B$5"
                    If Range("B5").Value = "" Then
                        Range("A6:F37").AutoFilter Field:=2
                    Else
                        Range("A6:F37").AutoFilter Field:=2, _
                            Criteria1:=Range("B5").Value
                    End If
                Case Is = "$C$5"
                    If Range("C5").Value = "" Then
                        Range("A6:F37").AutoFilter Field:=3
                    Else
                        Range("A6:F37").AutoFilter Field:=3, _
                            Criteria1:=Range("C5").Value
                    End If
                Case Is = "$D$5"
                    If Range("D5").Value = "" Then
                        Range("A6:F37").AutoFilter Field:=4
                    Else
                        Range("A6:F37").AutoFilter Field:=4, _
                            Criteria1:=Range("D5").Value
                    End If
                             
            End Select
        End If
    End Sub
    This is for 5 filter based on cell type value, I want to use the code below as watt filter for minimum - maximum, but i can not find a way to add this in the code above. Can somebody help me with this.

    Range("A6:F37").AutoFilter
    Range("A2:F37").AutoFilter Field:=6, Criteria1:=">=" & Range("A1").Value, _
    Operator:=xlAnd, Criteria2:="<=" & Range("B1").Value
    Hopefully one of you guys want to help me with this problem

  4. #4
    Forum Expert JBeaucaire's Avatar
    Join Date
    03-21-2004
    Location
    Bakersfield, CA
    MS-Off Ver
    2010, 2016, Office 365
    Posts
    33,492

    Re: Building a selection tool - problem with the range

    Maybe:

    Private Sub Worksheet_Change(ByVal Target As Range)
        If Not Intersect(Target, Range("A1:B1, A5:F5")) Is Nothing Then
            Select Case Target.Address
                Case "$A$5"
                    If Range("A5").Value = "" Then
                        Range("A6:F37").AutoFilter Field:=1
                    Else
                        Range("A6:F37").AutoFilter Field:=1, Criteria1:=Range("A5").Value
                    End If
                Case "$B$5"
                    If Range("B5").Value = "" Then
                        Range("A6:F37").AutoFilter Field:=2
                    Else
                        Range("A6:F37").AutoFilter Field:=2, Criteria1:=Range("B5").Value
                    End If
                Case "$C$5"
                    If Range("C5").Value = "" Then
                        Range("A6:F37").AutoFilter Field:=3
                    Else
                        Range("A6:F37").AutoFilter Field:=3, Criteria1:=Range("C5").Value
                    End If
                Case "$D$5"
                    If Range("D5").Value = "" Then
                        Range("A6:F37").AutoFilter Field:=4
                    Else
                        Range("A6:F37").AutoFilter Field:=4, Criteria1:=Range("D5").Value
                    End If
                Case "$A$1", "$B$1"
                    If WorksheetFunction.Count(Range("A1:B1")) < 2 Then
                        Range("A6:F37").AutoFilter Field:=6
                    Else
                        Range("A2:F37").AutoFilter Field:=6, Criteria1:=">=" & Range("A1").Value, _
                                            Operator:=xlAnd, Criteria2:="<=" & Range("B1").Value
                    End If
            End Select
        End If
    End Sub

  5. #5
    Registered User
    Join Date
    09-09-2014
    Location
    England
    MS-Off Ver
    2010
    Posts
    7

    Re: Building a selection tool - problem with the range

    Yes thankyou it works!

  6. #6
    Forum Expert JBeaucaire's Avatar
    Join Date
    03-21-2004
    Location
    Bakersfield, CA
    MS-Off Ver
    2010, 2016, Office 365
    Posts
    33,492

    Re: Building a selection tool - problem with the range

    As it appears you've reached a conclusion, I've marked this thread SOLVED for you.
    FYI, this is done through the Thread Tools located above the first post in this thread. Thanks.

+ Reply to Thread

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Similar Threads

  1. Building a Comparison tool... possible?
    By txguyg in forum Excel General
    Replies: 10
    Last Post: 12-20-2013, 06:57 AM
  2. How to call the Excel "range-selection tool"?
    By geophysicist in forum Excel Programming / VBA / Macros
    Replies: 1
    Last Post: 08-17-2013, 01:23 PM
  3. Building a search tool
    By lostgrave2001 in forum Excel - New Users/Basics
    Replies: 4
    Last Post: 04-29-2012, 08:33 AM
  4. Range Selection Problem
    By boylejob in forum Excel Programming / VBA / Macros
    Replies: 2
    Last Post: 06-02-2007, 12:09 AM
  5. building a search tool
    By Obi-Wan Kenobi in forum Excel Programming / VBA / Macros
    Replies: 1
    Last Post: 03-18-2006, 11:25 AM

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts

Search Engine Friendly URLs by vBSEO 3.6.0 RC 1