Multibox filter x 2

[Gregof1976]

Hi All

I use two miltibox to filter sub-form. Generally filter work perfect but in one of the option when I mark some Model and Family is Null then I received error. Example of my code and simple data base is enclosed.

Your help will be appreciated ;-)

Private Function BuildFilter() As Variant
 
 
Dim Model As Variant
Dim Family As Variant
 
Model = Null ' Subfilter used for Model
Family = Null ' Subfilter used for Family
 
 
[COLOR=seagreen]' Check for Models in multiselect list[/COLOR]
 
For Each varItem In Me.lstModel.ItemsSelected
     Model = Model & " [TblCar.Model] = """ & _
     Me.lstModel.ItemData(varItem) & """ OR "
 
Next
 
 
[COLOR=seagreen]'Test to see if we have subfilter for model[/COLOR]
 
If IsNull(Model) Then
[COLOR=seagreen]' do nothing[/COLOR]
 
Else
 
[COLOR=seagreen]' strip off last "OR" in the filter[/COLOR]
 
If Right(Model, 4) = " OR " Then
     Model = Left(Model, Len(Model) - 4)
 
End If
 
[COLOR=seagreen]'Add parentheses around the subfilter[/COLOR]
     varWhere = varWhere & "( " & Model & " ) And "
 
End If
 
 
 
[COLOR=seagreen]' Check for Familys in multiselect list[/COLOR]
For Each varItem In Me.lstFamily.ItemsSelected
     Family = Family & " [TblCar.Family] = """ & _
     Me.lstFamily.ItemData(varItem) & """ OR "
 
Next
 
 
[COLOR=seagreen]'Test to see if we have subfilter for Family[/COLOR]
 
If IsNull(Family) Then
[COLOR=seagreen]' do nothing[/COLOR]
 
Else
 
[COLOR=seagreen]' strip off last "OR" in the filter[/COLOR]
If Right(Family, 4) = " OR " Then
    Family = Left(Family, Len(Family) - 4)
 
End If
 
[COLOR=seagreen]'Add parentheses around the subfilter[/COLOR]
varWhere = varWhere & "( " & Family & " ) "
 
End If
 
 
 
BuildFilter = varWhere
 
End Function

 

[vbaInet]

I suspect that Model can contain Null and the zero-length string (i.e. ""). The best way to test for both cases is:

If Len(Model & vbNullString) = 0 Then

 

[Gregof1976]

I tried apply test for both cases as you suggeted but unfortunatelly still I get the same error.

 

[vbaInet]

Can you repost your code and put it in code tags so that it maintains the indents which makes it easy to read. Here's how -->

http://www.access-programmers.co.uk/forums/showthread.php?p=1009015#post1009015

 

[Gregof1976]

Code is re-posted ..

 

[vbaInet]

Good but is your original code not nicely indented? The main idea of putting code in code tags is so that we can see indents, e.g.:

If txbox1 = txtbox2 Then
    myVar = "Indent"     <--- you can see the indent. The logic is much clearer this way.
End If

 

[Gregof1976]

I hope that now is nicely indented ;-)

If anybody have some other ideas? I tried manage this second day ...it driving me crazy..

 

[vbaInet]

Here's the amended version (untested but it should work):

Private Function BuildFilter() As String
    
    Dim varItem As Variant
    Dim Model As String, Family As String
    
    ' Check for Models in multiselect list
    For Each varItem In Me.lstModel.ItemsSelected
         Model = Model & Chr(34) & Me.lstModel.ItemData(varItem) & Chr(34) & ", "
    Next
    
    varItem = Null
    
    ' strip of trailing comma and space and append field name
    If Len(Model) <> 0 Then
        Model = Left(Model, Len(Model) - 2)
        Model = "[TblCar.Model] IN (" & Model & ")"
    End If
    
    ' Check for Familys in multiselect list
    For Each varItem In Me.lstFamily.ItemsSelected
         Family = Family & Chr(34) & Me.lstFamily.ItemData(varItem) & Chr(34) & ", "
    Next

    ' strip of trailing comma and space and append field name
    If Len(Family) <> 0 Then
        Family = Left(Family, Len(Family) - 2)
        Family = "[TblCar.Family] IN (" & Family & ")"
        
        If Len(Model) <> 0 Then
            Family = " AND [TblCar.Family] IN (" & Family & ")"
        Else
            Family = "[TblCar.Family] IN (" & Family & ")"
        End If
    End If
    
    BuildFilter = Model & Family
 
End Function

By the way, don't you have Model ID and Family ID? Why are you not using those instead?

 

[Gregof1976]

I tried use attached code but filter work properly only for Model. When I mark some option for Model & Family then received an error. The same error is when mark only Family. Expected result is filtering each multibox seperatly and sometimes as a combination Model & Family. Thus user have should have four option:
- filter only Model
- filter only Family
- filter Model & Family
- filter Null for all

What benefit I can get if I used Model ID & Family ID? Is the code will be less complicated?

Thanks for your support.

ps. Can you be so kind and explain me use of 'Chr(34)'... is not cleare for me in your code.

 

[vbaInet]

Don't worry, I understood what you were trying to do.

The BuildFilter function looks alright to me. I don't know what you are doing with it after wards so I need to see that code too. I mean the code you use to set the Filter property of your form.

You may have two or familys or models with the same name so you use the ID because that's what makes it unique. Besides that the ID field is the indexed field so your search will run faster.

Chr(34) = "

 

[Gregof1976]

Finally I got my code ;-) If somebody are intrested in then I can attached sample of my multivalue filter database (now is work for three multibox).
Additionally I follow suggestion vbaInet to base on Model ID and Family ID.



Here it is code:

Option Compare Database
Option Explicit

Private Sub Polecenie20_Click()
    
    
    ' Update the record source
    If BuildFilter = "" Then
        Me.Products.Form.RecordSource = "SELECT * FROM qrydata " & BuildFilter
    Else
        Me.Products.Form.RecordSource = "SELECT * FROM qrydata WHERE " & BuildFilter
    End If
    
    'Requery the subform
    Me.Products.Requery
    
    
    
End Sub

Private Function BuildFilter() As Variant
    
  
    Dim varWhere As Variant
    Dim varItem As Variant
    Dim Model As Variant
    Dim Family As Variant
    Dim Color As Variant
 
        Model = Null  ' Subfilter used for Model
        Family = Null  ' Subfilter used for Family
        Color = Null   ' Subfilter used for Color
        varWhere = Null  ' Main filter
        
                 
               'Check for Models in multiselect list
            For Each varItem In Me.lstModel.ItemsSelected
                     Model = Model & " [TblCar.Model] = """ & _
                     Me.lstModel.ItemData(varItem) & """ OR "
            Next
               'Test to see if we have subfilter for model...
            If IsNull(Model) Then
               'do nothing
            Else
               'Strip off last "OR" in the filter
            If Right(Model, 4) = " OR " Then
               Model = Left(Model, Len(Model) - 4)
            End If
               'Add some parentheses around the subfilter
               varWhere = varWhere & "( " & Model & " ) AND "
            End If
    
    
               'Check for Familys in multiselect list
            For Each varItem In Me.lstFamily.ItemsSelected
                     Family = Family & " [TblCar.Family] = """ & _
                     Me.lstFamily.ItemData(varItem) & """ OR "
            Next
               'Test to see if we have subfilter for Family
            If IsNull(Family) Then
               'do nothing
            Else
               'strip off last "OR" in the filter
            If Right(Family, 4) = " OR " Then
               Family = Left(Family, Len(Family) - 4)
            End If
               'Add some parentheses around the subfilter
                varWhere = varWhere & "( " & Family & " ) AND "
            End If
                                    
                              
                    
                 'Check for Colors in multiselect list
            For Each varItem In Me.lstColor.ItemsSelected
                     Color = Color & " [TblCar.Color] = """ & _
                     Me.lstColor.ItemData(varItem) & """ OR "
            Next
                 'Test to see if we have subfilter for Color...
            If IsNull(Color) Then
                'do nothing
            Else
                 'strip off last "OR" in the filter
            If Right(Color, 4) = " OR " Then
               Color = Left(Color, Len(Color) - 4)
            End If
                 'Add some parentheses around the subfilte
               varWhere = varWhere & "( " & Color & " ) AND "
            End If
                                    
                                   
               'Add for varWhere value "" if not marked
            If IsNull(varWhere) Then
               varWhere = "''"
            Else
   
                'strip off last "AND" in the filter
            If Right(varWhere, 5) = " AND " Then
               varWhere = Left(varWhere, Len(varWhere) - 5)
            End If
                   
            End If
                                   
                                   
   
    BuildFilter = varWhere
       
    End Function

 

[vbaInet]

Good to see you got your code working!

... but you should be using what I gave you. The maximum number of OR you can have in a query I think is 80 so if you selected more than 80 rows in both listboxes, your code will fail. Also, there a maximum number of characters you can have in a SQL statement and with your code you will certainly soon reach the limit.

 

[Gregof1976]

How to remove all selection from multiselect via VBA code?
Can somebody support me in VBA code?

THX

 

[vbaInet]

Is it Extended or Simple multiselect?

 

[Gregof1976]

Simple multiselect

 

[vbaInet]

Alright, for Simple you can do:

Dim varItem As Variant
 
For Each varItem in Me.ListboxName.ItemsSelected
    Me.ListboxName.Selected(varItem) = False
Next

Or you could:

    Dim strSource As String
    
    strSource = Me.ListboxName.RowSource
    Me.ListboxName.RowSource = vbNullString
    Me.ListboxName.RowSource = strSource

You decide which one is faster.

 

[Gregof1976]

Both work perfect but I prefer first one.

Once more thanx for you support ;-)

 

[vbaInet]

No problemo!