So Lost on how to accomplish this form/subform or could be report 1

[tmcrouse]

I have 11 listboxes and have been reading and researching for almost 2wks now with nothing that is helping. All I attempt does not work. the 11 listboxes the user can select 1 or more items from each. Then I need what they select to be used as the filters for a query. My listboxes are unbound because if bound, they will change the data in my main table. I have multiple tables that have primary keys and a foreign key links them to main table. Each listbox has a row source from their table. For example I have a state table which lists all the states and need the user to have the ability to select any or all states they want. No, I am not using All option for anything. Too complex. The main table might not list a state because the particular state might not have any orders associated yet. So, if the user would select an item in listbox that is not in main table, that item will just not appear. But they still need the option to select whatever they want. When they are done selecting what they want, I have a query to display results, however the query only contains 5 of the listboxes. The listboxes are:

lob, yr, st_cd, mth, bus_unit, prod_nm, cat, measure, sub, comm_lvl, comm_type


The query has the following:

program, lob, plan, st_cd, measure, comm_type, mbr_target, mbr_converted, effectiveness

I have tried so many options for coding this. Here they are:

Private Sub command8_click()
On Error GoTo Err_Handler
    'Purpose:  Open the report filtered to the items selected in the list box.
    'Author:   Allen J Browne, 2004.   [URL unfurl="true"]http://allenbrowne.com[/URL]
    Dim varItem As Variant      'Selected items
    Dim strWhere As String      'String to use as WhereCondition
    Dim strDescrip As String    'Description of WhereCondition
    Dim lngLen As Long          'Length of string
    Dim strDelim As String      'Delimiter for this field type.
    Dim strDoc As String        'Name of report to open.
    
    'strDelim = """"            'Delimiter appropriate to field type. See note 1.
    strDoc = "Search_Quality_Programs"

    'Loop through the ItemsSelected in the list box.
    With Me.List1
        For Each varItem In .ItemsSelected
            If Not IsNull(varItem) Then
                'Build up the filter from the bound column (hidden).
                strWhere = strWhere & strDelim & .ItemData(varItem) & strDelim & ","
                'Build up the description from the text in the visible column. See note 2.
                strDescrip = strDescrip & """" & .Column(1, varItem) & """, "
            End If
        Next
    End With
    
    'Remove trailing comma. Add field name, IN operator, and brackets.
    lngLen = Len(strWhere) - 1
    If lngLen > 0 Then
        strWhere = "[LOB] IN (" & Left$(strWhere, lngLen) & ")"
        lngLen = Len(strDescrip) - 2
        If lngLen > 0 Then
            strDescrip = "QualMain: " & Left$(strDescrip, lngLen)
        End If
    End If
   
    'Omit the last argument for Access 2000 and earlier. See note 4.
    DoCmd.OpenReport strDoc, acViewPreview, WhereCondition:=strWhere, OpenArgs:=strDescrip

Exit_Handler:
    Exit Sub

Err_Handler:
    If Err.Number <> 2501 Then  'Ignore "Report cancelled" error.
        MsgBox "Error " & Err.Number & " - " & Err.Description, , "cmdPreview_Click"
    End If
    Resume Exit_Handler
End Sub

The above does nothing for me.

Private Sub command8_click()

    ' Update the record source
    If BuildFilter = "" Then
    Me.frmQual_Sub.Form.RecordSource = "select * from qualq1 where " & BuildFilter
    End If
    
    'Requery the subform
    Me.frmQual_Sub.Requery
    End Sub
    
Private Function BuildFilter() As Variant
    Dim varWhere As Variant
     
    varWhere = Null  ' Main filter
        
If Me.List1 > "" Then
        varWhere = varWhere & "[lob] LIKE """ & Me.List1 & "*"" AND "
    End If
        
If Me.List2 > "" Then
        varWhere = varWhere & "[yr] LIKE """ & Me.List2 & "*"" AND "
    End If
    
If Me.List3 > "" Then
        varWhere = varWhere & "[mth] LIKE """ & Me.List3 & "*"" AND "
    End If
        
If Me.List4 > "" Then
        varWhere = varWhere & "[st_cd] LIKE """ & Me.List4 & "*"" AND "
    End If
        
If Me.List5 > "" Then
        varWhere = varWhere & "[bus_unit] LIKE """ & Me.List5 & "*"" AND "
    End If
        
If Me.List6 > "" Then
        varWhere = varWhere & "[prod_nm] LIKE """ & Me.List6 & "*"" AND "
    End If
       
If Me.list7 > "" Then
        varWhere = varWhere & "[category_condition] LIKE """ & Me.list7 & "*"" AND "
    End If
        
If Me.list8 > "" Then
        varWhere = varWhere & "[measure] LIKE """ & Me.list8 & "*"" AND "
    End If
    
If Me.list9 > "" Then
        varWhere = varWhere & "[sub_measure] LIKE """ & Me.list9 & "*"" AND "
    End If
       
If Me.List10 > "" Then
        varWhere = varWhere & "[comm_lvl] LIKE """ & Me.List10 & "*"" AND "
    End If
        
If Me.List11 > "" Then
        varWhere = varWhere & "[comm_type] LIKE """ & Me.List11 & "*"" AND "
    End If
       
     'Check if there is a filter to return...
    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

this does nothing
The 2 above just sit and do nothing

Private sub command8_click()
Dim msg As String
  Dim i As Integer
    
  With Me.List1

   'loop through all the entries in the list
    
    For i = 0 To .ListCount
    
      'if this item is selected, add it to the msg variable
      If .Selected(i) Then
      
        'now we'll pull the value of the first column at the specified row and add it to the msg variable
        msg = msg & .Column(0, i) & vbCrLf
        
      End If
      
    Next i  'go to the next item and check that one
    End With
    
    With Me.List2
    
    For i = 0 To .ListCount
    If .Selected(i) Then
    msg = msg & .Column(0, i) & vbCrLf
    End If
    
    Next i
    
  End With
  
With Me.List3
    
    For i = 0 To .ListCount
    If .Selected(i) Then
    msg = msg & .Column(0, i) & vbCrLf
    End If
    
    Next i
    
  End With
  
  With Me.List4
    
    For i = 0 To .ListCount
    If .Selected(i) Then
    msg = msg & .Column(0, i) & vbCrLf
    End If
    
    Next i
    
  End With
  
   With Me.List5

   'loop through all the entries in the list
    
    For i = 0 To .ListCount
    
      'if this item is selected, add it to the msg variable
      If .Selected(i) Then
      
        'now we'll pull the value of the first column at the specified row and add it to the msg variable
        msg = msg & .Column(0, i) & vbCrLf
        
      End If
      
    Next i  'go to the next item and check that one
    End With
    
    With Me.List6
    
    For i = 0 To .ListCount
    If .Selected(i) Then
    msg = msg & .Column(0, i) & vbCrLf
    End If
    
    Next i
    
  End With
  
With Me.list7
    
    For i = 0 To .ListCount
    If .Selected(i) Then
    msg = msg & .Column(0, i) & vbCrLf
    End If
    
    Next i
    
  End With
  
  With Me.list8
    
    For i = 0 To .ListCount
    If .Selected(i) Then
    msg = msg & .Column(0, i) & vbCrLf
    End If
    
    Next i
    
  End With
  
   With Me.list9

   'loop through all the entries in the list
    
    For i = 0 To .ListCount
    
      'if this item is selected, add it to the msg variable
      If .Selected(i) Then
      
        'now we'll pull the value of the first column at the specified row and add it to the msg variable
        msg = msg & .Column(0, i) & vbCrLf
        
      End If
      
    Next i  'go to the next item and check that one
    End With
    
    With Me.List10
    
    For i = 0 To .ListCount
    If .Selected(i) Then
    msg = msg & .Column(0, i) & vbCrLf
    End If
    
    Next i
    
  End With
  
With Me.List11
    
    For i = 0 To .ListCount
    If .Selected(i) Then
    msg = msg & .Column(0, i) & vbCrLf
    End If
    
    Next i
    
  End With
    
  'now the msg variable should contain a list of items that were selected
  MsgBox msg
End sub

The above returns what was selected but I cannot figure out how to maximize on the concept of the message box to turn it into something I could use to either create a query to query my main table or filter on the query I already have. Please help me.

 

[MajP]

This may help, to look at a clean repeatable methodology. Each list box is simply a cut and paste once you get the first one correct.

Public Sub createFilter()
  Dim strType As String
  Dim strCritical As String
  Dim strScope As String
  Dim strRRB1 As String
  Dim strRRB2 As String
  Dim strArea As String
  Dim strKPP
  Dim strFilter As String
  Dim strChangeType As String
  Dim itm As Variant
  
'Filter by ChangeType
  For Each itm In Me.lstChangeType.ItemsSelected
     If strChangeType = "" Then
        strChangeType = "strChangeType = '" & Me.lstChangeType.ItemData(itm) & "'"
     Else
       strChangeType = strChangeType & " OR changeTypeID = '" & Me.lstChangeType.ItemData(itm) & "'"
     End If
  Next itm
  If Not strChangeType = "" Then
    strChangeType = " (" & strChangeType & ") AND "
  End If
  'Filter by Type
  For Each itm In Me.lstFilterByType.ItemsSelected
     If strType = "" Then
        strType = "strRequirementType_Threshold_Objective = '" & Me.lstFilterByType.ItemData(itm) & "'"
     Else
       strType = strType & " OR strRequirementType_Threshold_Objective = '" & Me.lstFilterByType.ItemData(itm) & "'"
     End If
  Next itm
  If Not strType = "" Then
    strType = " (" & strType & ") AND "
  End If
  
 'Filter by Critical
 For Each itm In Me.lstFilterByCritical.ItemsSelected
   If strCritical = "" Then
      strCritical = "blnCriticalRequirement = " & Me.lstFilterByCritical.ItemData(itm)
   Else
     strCritical = strCritical & " OR blnCriticalRequirement = " & Me.lstFilterByCritical.ItemData(itm)
   End If
 Next itm
  If Not strCritical = "" Then
    strCritical = "(" & strCritical & ") AND "
  End If
 
 'Filter by scope
 For Each itm In Me.lstFilterByScope.ItemsSelected
   If strScope = "" Then
      strScope = "inScope = " & Me.lstFilterByScope.ItemData(itm)
   Else
     strScope = strScope & " OR inScope = " & Me.lstFilterByScope.ItemData(itm)
   End If
 Next itm
  If Not strScope = "" Then
    strScope = " (" & strScope & ") AND "
  End If
 
 'Filter by RRB1 resolution
  For Each itm In Me.lstRRB1.ItemsSelected
   If strRRB1 = "" Then
      strRRB1 = "strResults = '" & Me.lstRRB1.ItemData(itm) & "'"
   Else
     strRRB1 = strRRB1 & " OR strResults = '" & Me.lstRRB1.ItemData(itm) & "'"
   End If
 Next itm
  If Not strRRB1 = "" Then
    strRRB1 = " (" & strRRB1 & ") AND "
  End If
 
 'Filter by RRB2 Resolution
   For Each itm In Me.lstRRB2.ItemsSelected
   If strRRB2 = "" Then
      strRRB2 = "strRRB2Results = '" & Me.lstRRB2.ItemData(itm) & "'"
   Else
     strRRB2 = strRRB2 & " OR strRRB2Results = '" & Me.lstRRB2.ItemData(itm) & "'"
   End If
 Next itm
  If Not strRRB2 = "" Then
    strRRB2 = " (" & strRRB2 & ") AND "
  End If
 
 'Filter by KPP
 For Each itm In Me.lstFilterByKPP.ItemsSelected
   If strKPP = "" Then
      strKPP = "isKPP = " & Me.lstFilterByKPP.ItemData(itm)
   Else
     strKPP = strKPP & " OR isKPP = " & Me.lstFilterByKPP.ItemData(itm)
   End If
 Next itm
  If Not strKPP = "" Then
    strKPP = "(" & strKPP & ") AND "
  End If
  
 'Filter by Area
 For Each itm In Me.lstFilterByArea.ItemsSelected
   If strArea = "" Then
      strArea = "strFunctionalArea = '" & Me.lstFilterByArea.ItemData(itm) & "'"
   Else
     strArea = strArea & " OR strFunctionalArea = '" & Me.lstFilterByArea.ItemData(itm) & "'"
   End If
 Next itm
  If Not strArea = "" Then
    strArea = " (" & strArea & ") AND "
  End If
  
 strFilter = strType & strCritical & strScope & strRRB1 & strRRB2 & strKPP & strArea & strChangeType
 If Not strFilter = "" Then
    strFilter = Left(strFilter, Len(strFilter) - 5)
 End If
 Debug.Print strFilter
 
 
 
   
   Me.FilterOn = False
   Me.Filter = ""
   Me.Filter = strFilter
   Me.FilterOn = True
 If Me.Recordset.RecordCount = 0 Then
   Me.FilterOn = False
   MsgBox "No Records"
 End If
End Sub

Normally I would create a function instead of a sub. The function would simply return the string
So something more like

public function GetFilterString() as string
  'all the same code as above
  GetFilterString = strFilter
end function

Now you can use that string anywhere. Filter the form or append it as the where clause of a query. Also in this case it is or within a category and And between categories.
So something like
(color = 'Black' or color = 'Blue') and (size = 'large' or size = 'small')

 

[tmcrouse]

So each filter by filter 1 listbox? Then if I decide to do this as a sub function then I would just call that function in my command button where my query is?

 

[MajP]

yes.

BTW,

The main table might not list a state because the particular state might not have any orders associated yet. So, if the user would select an item in listbox that is not in main table, that item will just not appear. But they still need the option to select whatever they want. When they are done selecting what they want, I have a query to display results, however the query only contains 5 of the listboxes.

That does not make any sense. I would never give a user the ability to select choice that do not exist.
In other words my listbox row sources are something like
"select Distinct someState from mainTable

 

[tmcrouse]

The listboxes show all the possible choices and they select based on what they want to see and when the query runs it only display what is in the main table. Data already there. It will not display a state that is not there. Make sense?

 

[MajP]

Not the way I would do it. If there can be "sm, med, large, XL, and XXL" orders, but there is only orders currently with Med, and Large, I will only display in my search listbox Med, Large. It is not data entry it is search. I would not give them an option to search for XL only for them to get a message box that says no record exists. My choices in the search listboxes would be based in the items in the main table. If someone later adds an order for XL it would appear automatically as a search choice.

 

[tmcrouse]

I see what you are saying, however the data will all be there once I load it all. Right now I am building the DB and forms and need to test and make sure all works before I load stuff. Everything WILL be there once I am done but so far I cannot get this to work with my SQL query. When I click on my command button that calls the function it just sits. I think I am going to have to send this to MS Access people and get some help. This is beyond me. I am a SAS person.

 

[MajP]

If you want put your db in dropbox and I will take a look. You can use dummy data if proprietary. Probably take me 20 mins to get it to work, 30 if I am drinking at the time.

 

[MajP]

For each listbox on a form I put in the field name to filter and the type of field (text,numeric,Date) in the tag property. Example

Color;Text
or
TypeID;Numeric

Then with the following function I can return the filter string from all the multi select listboxes, then decide what to do with the filter.

Public Function GetFilterFromListBoxes() As String
  Dim lst As Access.ListBox
  Dim ctrl As Access.Control
  Dim fieldName As String
  Dim fieldType As String
  Dim TotalFilter As String
  Dim ListFilter As String
  Dim itm As Variant
  For Each ctrl In Me.Controls
     If ctrl.ControlType = acListBox Then
       fieldName = Split(ctrl.Tag, ";")(0)
       fieldType = Split(ctrl.Tag, ";")(1)
       For Each itm In ctrl.ItemsSelected
       If ListFilter = "" Then
         ListFilter = fieldName & " = " & GetProperType(ctrl.ItemData(itm), fieldType)
       Else
         ListFilter = ListFilter & " OR " & fieldName & " = " & GetProperType(ctrl.ItemData(itm), fieldType)
       End If
       Next itm
       If Not ListFilter = "" Then
          ListFilter = " (" & ListFilter & ") AND "
       End If
       If TotalFilter = "" And ListFilter <> "" Then
         TotalFilter = ListFilter
       ElseIf TotalFilter <> "" And ListFilter <> "" Then
         TotalFilter = TotalFilter & ListFilter
       End If
       ListFilter = ""
     End If
  Next ctrl
  'remove And
  If Not TotalFilter = "" Then
    TotalFilter = Left(TotalFilter, Len(TotalFilter) - 5)
 End If
  GetFilterFromListBoxes = TotalFilter
End Function
Public Function GetProperType(varItem As Variant, fieldType As String) As Variant
  If fieldType = "Text" Then
    GetProperType = sqlTxt(varItem)
  ElseIf fieldType = "Date" Then
    GetProperType = SQLDate(varItem)
  Else
    GetProperType = varItem
  End If
End Function
Public Function sqlTxt(varItem As Variant) As Variant
  If Not IsNull(varItem) Then
    varItem = Replace(varItem, "'", "''")
    sqlTxt = "'" & varItem & "'"
  End If
End Function
Function SQLDate(varDate As Variant) As Variant
     If IsDate(varDate) Then
        If DateValue(varDate) = varDate Then
            SQLDate = Format$(varDate, "\#mm\/dd\/yyyy\#")
        Else
            SQLDate = Format$(varDate, "\#mm\/dd\/yyyy hh\:nn\:ss\#")
        End If
    End If
End Function

For my test database I get a filter string something like

(strParentSRnumber = 'SR1.1.1.2') AND (strRequirementType = 'Threshold' OR strRequirementType = 'Objective') AND (autoAreaID = 10 OR autoAreaID = 54 OR autoAreaID = 5 OR autoAreaID = 90)

I could dramatically shorten the output by using the IN operator instead of OR, but this works fine.

 

[dhookom]

I use a generic listbox filter generator that adds where conditions like: " AND [Color] IN ('Red", 'Green', 'Yellow') " or " AND ID IN (1,4,14,22,98) "

Function BuildIn(lboListBox As ListBox, _
        strFieldName As String, strDelim As String) As String
[COLOR=#4E9A06]    'lboListBox: list box control object
    'strFieldName: name of the field to compare to the values
    'strDelim: zero-length string for numeric, quotes for strings, and # for datess[/color]    Dim strIn As String
    Dim varItem As Variant
        
    If lboListBox.ItemsSelected.Count > 0 Then
        strIn = " AND " & strFieldName & " In ("
        For Each varItem In lboListBox.ItemsSelected
            strIn = strIn & strDelim & lboListBox.ItemData(varItem) & strDelim & ", "
        Next
[COLOR=#4E9A06]        'remove the last ", " and add the ")"[/color]        
        strIn = Left(strIn, Len(strIn) - 2) & ") "
    End If
    BuildIn = strIn

End Function

Duane
Hook'D on Access
MS Access MVP

 

[tmcrouse]

That would be great. The form that is the problem when the DB opens is search quality programs. If you click you will see the form. I have changed it based on multiple feedback and placed my 11 multi-listboxes in the header and then where I need the results in the detail. You will notice that my row source is set up to the main 11 tables. So like state feeds state and not the QualMain query which is my main table. That is where data is going to be dumped after I am done building. I will be dumping about 5000 records and the QID is the way to keep them from not duplicating, but as you can see data is duplicated because all states have COM, HIX, MCD, and MCR. They all have the same program. This is why I did not use the QualMain as my record source. Plus I need to calculate that effectiveness so that is why I have QualQ1. So, I just need to allow the end users to select 1 or more items from each box and then have it look at my QualQ1 query and display the results in the detail information of the Search Quality Forms. I have tried what you suggested but the issue is I cannot get any of this to work in a query.

 

[tmcrouse]

I don't see an attachment.

 

[MajP]

So here is a modified main function will work from 1 to N different listboxes.

Public Function GetFilterFromListBoxes() As String
  Dim lst As Access.ListBox
  Dim ctrl As Access.Control
  Dim fieldName As String
  Dim fieldType As String
  Dim TotalFilter As String
  Dim ListFilter As String
  Dim itm As Variant
  'Each listbox needs a tag property with the  field name and the field type
  'Seperate these with a ;
  'The types are Text, Numeric, or Date
  For Each ctrl In Me.Controls
     If ctrl.ControlType = acListBox Then
       fieldName = Split(ctrl.Tag, ";")(0)
       fieldType = Split(ctrl.Tag, ";")(1)
       For Each itm In ctrl.ItemsSelected
       If ListFilter = "" Then
         ListFilter = GetProperType(ctrl.ItemData(itm), fieldType)
       Else
         ListFilter = ListFilter & " , " & GetProperType(ctrl.ItemData(itm), fieldType)
       End If
       Next itm
       If Not ListFilter = "" Then
          ListFilter = fieldName & " IN (" & ListFilter & ")"
       End If
       If TotalFilter = "" And ListFilter <> "" Then
         TotalFilter = ListFilter
       ElseIf TotalFilter <> "" And ListFilter <> "" Then
         TotalFilter = TotalFilter & " AND " & ListFilter
       End If
       ListFilter = ""
     End If
  Next ctrl
  GetFilterFromListBoxes = TotalFilter
End Function

So in this version the returned string for my 4 listboxes is something like this

CapabilityID IN (230) AND ReqType IN ('Threshold' , 'Objective') AND AreaID IN (10 , 54 , 5)

I say 4 since one of the textboxes has no selection and does not show up.

Also I do not think the IN is going to make any difference than using ORs. It will look shorter. There is a limit of 99 ANDs in a where clause, but no limit on ORs.

 

[tmcrouse]

I cannot figure out how to use this dropbox. There is no way to share it with you. It does not recognize Majp. Are there any instructions on here how to dropbox?

 

[tmcrouse]

I don't see it attached.

 

[MajP]

Basically just popped in the code I already shown, and put in the tag properties. I cannot fully verify it works because there is no data in it. Appears to work fine.

So I highlighted a bunch of choices and got this:

LOB IN ('COM','MCD') AND YR IN ('2014') AND MTH IN ('Jan','Feb','Mar') AND st_cd IN ('CT','FL') AND prod_nm IN ('CHP','EPO','HMO','LPPO') AND COMM_Type IN ('LIVE_OUTBOUND_CALL','IVR_CALL','TEXT_MESSAGE','MOBILE_APPLICATION') AND CONDITION_CATEGORY IN ('Access and Availability of Care','Behavioral Health','Cardiovascular','Diabetes') AND Measure IN ('AAB','AAP','ABA','ADD') AND SUB_MEASURE IN ('30DAY','7DAY','AAB','ABA') AND COMM_LVL IN ('Member','Provider') AND BUS_UNIT IN ('ACM','AGP','BCBSA','CEEM')

Looks fine

Here is the other code. I renamed your command buttons

 Private Sub cmdReset_Click()
  Dim ctrl As Access.Control
  Dim itm As Variant
  For Each ctrl In Me.Controls
    If ctrl.ControlType = acListBox Then
      If ctrl.MultiSelect = 0 Then
        ctrl = Null
      Else
        For Each itm In ctrl.ItemsSelected
            ctrl.Selected(itm) = False
        Next
      End If
    End If
  Next ctrl
  Me.Filter = ""
  Me.FilterOn = False
End Sub

Private Sub cmdResults_Click()
   Dim FormFilter As String
   FormFilter = GetFilterFromListBoxes
   Debug.Print FormFilter
   Me.FilterOn = False
   Me.Filter = FormFilter
   Me.FilterOn = True
End Sub

http://www.4shared.com/file/Q9gP1uRfce/MajPDemoListBoxSearch.html

Sorry, I put this on 4 shared because I have an account and a utility. It has become an unfriendly site with lots of spam. Read the choices carefully. Should see a download under the file name. Then after hitting that should see a greyed out box saying free download and a 20 sec wait. Avoid hitting any bright color downloads.

 

[tmcrouse]

Ok, I loaded it. Now I need to figure out when I click reset it will actually clear out what I see in that filter selection because it shows the same thing everytime no matter what I select. Then I need to figure out how to have it show everything in QualQ1. Becuase if I click say just LOB COM and then State CA and nothing else and then click for results, then it should display all the LOB that are COM and related to State CA.

 

[tmcrouse]

Oh wait. I am an idiot. First I need to code the rest of the listboxes....................ugh. Ok. Let me do that and I will let you know................

 

[tmcrouse]

Oh, no I don't they are already done.........Ok, so now I need to figure out how to make these filters change everytime I rest and select something new so it will query QualQ1 and then display all those results in my details box.

 

[MajP]

Sorry forgot to fix your formatting, which is jacked. You are in single form view, needed to switch to continous. Then you have to move the labels into the header. Then you have to shrink the detail section. It is working fine, but the view is so messed up you cannot tell. I will reupload.