multiple multi-select lists. Also DAO ADO question.

[amy3000]

I need to say first that I don't really know anything about VBA. I know how to cut and paste. I used a tutorial at Martin Green's website on creating dynamic reports:

http://www.fontstuff.com/access/acctut19.htm

.

I have several tables all linked to the main Person table with a foreign key. I want to have a multiple multi-select boxes eg. List 1: Profession (eg, physician, RN, EMT, etc) List 2: Occupation-really means experience (eg, Administration, Research, Clinical, etc) that will then open a report with these criteria.

I'm not sure how to deal with null values. With the data already entered none of the physicians listed work activities. So if I select "physician" in List 1 no records appear because they have no records in the "Occupation" List. I decided to add a multi-select list of all the people in the database thinking everyone is of course in that list and that then all physicians would appear whether or not any other criteria were in the other list boxes. It doesn't seem to work. I know have 4 lists. It seems to work ok otherwise. Here is the code (with some comments):

Private Sub cmdOK_Click()
Dim varItem As Variant
Dim strLAST_NAME As String
Dim strCREDENTIAL_TYPE As String
Dim strOCCUPATION_TYPE As String
Dim strTRAINING_TYPE As String
Dim strFilter As String
' Check that the report is open
If SysCmd(acSysCmdGetObjectState, acReport, "rptMulti") <> acObjStateOpen Then
MsgBox "You must open the report first."
Exit Sub
End If
' Build criteria string from lstName listbox
For Each varItem In Me.lstName.ItemsSelected
strLAST_NAME = strLAST_NAME & ",'" & Me.lstName.ItemData(varItem) _
& "'"
Next varItem
If Len(strLAST_NAME) = 0 Then
strLAST_NAME = "Like '*'"
Else
strLAST_NAME = Right(strLAST_NAME, Len(strLAST_NAME) - 1)
strLAST_NAME = "IN(" & strLAST_NAME & ")"
End If

' Build criteria string from lstCredentails listbox
For Each varItem In Me.lstCredentials.ItemsSelected
strCREDENTIAL_TYPE = strCREDENTIAL_TYPE & ",'" & Me.lstCredentials.ItemData(varItem) _
& "'"
Next varItem
If Len(strCREDENTIAL_TYPE) = 0 Then
strCREDENTIAL_TYPE = "Like '*'"
Else
strCREDENTIAL_TYPE = Right(strCREDENTIAL_TYPE, Len(strCREDENTIAL_TYPE) - 1)
strCREDENTIAL_TYPE = "IN(" & strCREDENTIAL_TYPE & ")"
End If
' Build criteria string from lstOccupations listbox
For Each varItem In Me.lstOccupations.ItemsSelected
strOCCUPATION_TYPE = strOCCUPATION_TYPE & ",'" & Me.lstOccupations.ItemData(varItem) _
& "'"
Next varItem
If Len(strOCCUPATION_TYPE) = 0 Then
strOCCUPATION_TYPE = "Like '*'"
Else
strOCCUPATION_TYPE = Right(strOCCUPATION_TYPE, Len(strOCCUPATION_TYPE) - 1)
strOCCUPATION_TYPE = "IN(" & strOCCUPATION_TYPE & ")"
End If
' Build criteria string from lstTraining listbox
For Each varItem In Me.lstTraining.ItemsSelected
strTRAINING_TYPE = strTRAINING_TYPE & ",'" & Me.lstTraining.ItemData(varItem) _
& "'"
Next varItem
If Len(strTRAINING_TYPE) = 0 Then
strTRAINING_TYPE = "Like '*'"
Else
strTRAINING_TYPE = Right(strTRAINING_TYPE, Len(strTRAINING_TYPE) - 1)
strTRAINING_TYPE = "IN(" & strTRAINING_TYPE & ")"
End If
' Build filter string
strFilter = "[LAST_NAME] " & strLAST_NAME & _
" AND [CREDENTIAL_TYPE] " & strCREDENTIAL_TYPE & _
" AND [OCCUPATION_TYPE] " & strOCCUPATION_TYPE & _
" AND [TRAINING_TYPE] " & strTRAINING_TYPE
' Apply the filter and switch it on
With Reports![rptMulti]
.Filter = strFilter
.FilterOn = True
End With
End Sub

Re DAO. I followed Martin Green's preference for DAO code (I couldn't do it myself otherwise) and set the options in tools. However, does this mean the report won't run on other computers with Access 2000 that don't have that set? If so, I need to change it because this may be run on several computers. Then I may be up a crick since I don't really understand what it is. I know I'm getting in over my head but I'm pretty good at this cutting an pasting.

 

[FancyPrairie]

The following code will build the Where clause for you regardless of how many listboxes you have on your form. The tag property (and name of the controls if you have 2 fields that represent a date range) is the key to making it work. To test it, create a new module, copy and paste the code below in the new module, then set the TagProperty of each of the listboxes correctly. Then open the report like this:

Docmd.OpenReport "rptYourReport",acViewPreview,,BuildWhereClause(Me)


Note that the code doesn't care whether you have 0 pairs of textboxes (date ranges) or many. Nor does it care whether you have 0 multi-select listboxes or many. It will handle it all. Again, the key to making it work is setting the tag property correctly and naming the controls correctly.

For example, suppose you have 2 text boxes (named ServiceDate_BeginR and ServiceDate_EndR) and 1 multi-select list box (list of equipment).

Now suppose the user enters a 6/1/2005 for the begin date range and 6/1/2006 for the end date range. And also suppose the user selects EqupID 1 and EquipID 5 from the list box.
The following function will return your where clause as:

(Betweeen #6/1/2005# and #6/1/2006#) and (EquipID In(1,5))

The key to how this works is using a naming convention and using the Tag Property. The function below assumes that the text boxes that represent a pair of date ranges has a naming convention where the Base Names are the same but the suffix is either _BeginR (ServiceDate_BeginR) or _EndR (ServiceDate_EndR). The tag property of the textbox that represents the 1st date in the range (ServiceDate_BeginR) has the following format:
Where=YourTableName.YourDateFieldName,Date;

The only things you need to note in the multi-select listbox is the Tag property and the bound column. The format of the tag property should look like this:

Where=YourTableName.YourFieldName,Number;

Where EquipID represents the bound column of the list box.

Option Compare Database
Option Explicit

    Dim mstrAnd As String
    Dim mstrFilter As String
    
Function BuildWhereClause(frm As Form) As String

'********************************
'*  Declaration Specifications  *
'********************************

    On Error GoTo ErrHandler

'****************
'*  Initialize  *
'****************

    mstrFilter = vbNullString
    mstrAnd = vbNullString
    
    BuildWhereClause_DateRange frm
    BuildWhereClause_ListBox frm
    
    If (InStr(1, mstrFilter, "!!!Error!!!") > 0) Then
        MsgBox "error"
        BuildWhereClause = "!!!ERROR!!!"
        Exit Function
    End If
    
    BuildWhereClause = mstrFilter
    
'********************
'*  Exit Procedure  *
'********************
        
ExitProcedure:

    Exit Function

'****************************
'*  Error Recovery Section  *
'****************************
        
ErrHandler:

    Err.Raise Err.Number,"BuildWhereClause" & ";" & Err.Source,Err.Description        
 
End Function


Function BuildWhereClause_DateRange(frm As Form)

'********************************
'*  Declaration Specifications  *
'********************************

    Dim ctl As Control
    Dim ctlEndR As Control
    
    Dim strField As String
    Dim strType As String
    
    Dim i As Integer
    Dim j As Integer
    Dim k As Integer
    
    On Error GoTo ErrHandler

'*********************************************************
'*  Loop thru all controls on form to find list box(es)  *
'*********************************************************

    For Each ctl In frm.Controls
                
        If (ctl.ControlType = acTextBox) And (Right$(ctl.Name, 7) = "_BeginR") Then
                
        '*************************************************************************************************
        '*  Should this list box be processed?                                                           *
        '*  If so, then tag property contains the name of the table and field and the type of the field  *
        '*      (Structure of tag property:  Where=TableName.FieldName,DataType,    )                    *
        '*      NOTE that the code assumes the tag property is structured properly                       *
        '*************************************************************************************************
            
            If ((ctl.Enabled) And (Not ctl.Locked) And (InStr(ctl.Tag, "Where=") > 0)) Then
                
                If (IsNull(ctl)) Then GoTo 7000
                On Error Resume Next
                Set ctlEndR = frm(Left$(ctl.Name, Len(ctl.Name) - 7) & "_EndR")
                If (Err.Number = 2465) Then
                    Err.Clear
                    GoTo 7000
                End If
                If (IsNull(ctlEndR)) Then GoTo 7000
    
                On Error GoTo ErrHandler
                
                j = InStr(ctl.Tag, "Where=")
                k = InStr(j, ctl.Tag, ",")
                strField = Mid(ctl.Tag, j + 6, k - (j + 6))
                
                j = InStr(k + 1, ctl.Tag, ";")
                strType = Mid(ctl.Tag, k + 1, j - k - 1)
                
                mstrFilter = mstrFilter & mstrAnd & " (" & strField & " Between #" & ctl.Value & "# AND #" & ctlEndR.Value & "#) "
                mstrAnd = " AND "
                
            End If
        End If
7000:
    Next
    
'********************
'*  Exit Procedure  *
'********************
        
ExitProcedure:

    Exit Function

'****************************
'*  Error Recovery Section  *
'****************************
        
ErrHandler:
        
Err.Raise Err.Number,"BuildWhereClause_DateRange" & ";" & Err.Source,Err.Description

End Function


Function BuildWhereClause_ListBox(frm)

'********************************
'*  Declaration Specifications  *
'********************************

    Dim ctl As Control
    
    Dim varItem As Variant
    
    Dim strField As String
    Dim strType As String
    
    Dim i As Integer
    Dim j As Integer
    Dim k As Integer
    
    On Error GoTo ErrHandler

'*********************************************************
'*  Loop thru all controls on form to find list box(es)  *
'*********************************************************

    For Each ctl In frm.Controls
                
        If (ctl.ControlType = acListBox) Then
                
        '*************************************************************************************************
        '*  Should this list box be processed?                                                           *
        '*  If so, then tag property contains the name of the table and field and the type of the field  *
        '*      (Structure of tag property:  Where=TableName.FieldName,DataType;    )                    *
        '*      NOTE that the code assumes the tag property is structured properly                       *
        '*************************************************************************************************
            
            If ((ctl.Enabled) And (Not ctl.Locked) And (ctl.ItemsSelected.Count > 0) And (InStr(ctl.Tag, "Where=") > 0)) Then
                
                j = InStr(ctl.Tag, "Where=")
                k = InStr(j, ctl.Tag, ",")
                strField = Mid(ctl.Tag, j + 6, k - (j + 6))
                
                j = InStr(k + 1, ctl.Tag, ";")
                strType = Mid(ctl.Tag, k + 1, j - k - 1)
                
                mstrFilter = mstrFilter & mstrAnd & " (" & strField & " In ("
                
        '******************************************
        '*  Loop thru items selected in list box  *
        '******************************************
        
                For Each varItem In ctl.ItemsSelected
                    
                    If (strType = "String") Then
                        mstrFilter = mstrFilter & "'" & ctl.Column(ctl.BoundColumn - 1, varItem) & "', "
                    ElseIf (strType = "Number") Then
                        mstrFilter = mstrFilter & ctl.Column(ctl.BoundColumn - 1, varItem) & ", "
                    End If
                    
                Next varItem
    
                mstrFilter = Mid(mstrFilter, 1, Len(mstrFilter) - 2) & ")) "
                mstrAnd = " AND "
                
            End If
        End If
    
    Next
    
'********************
'*  Exit Procedure  *
'********************
        
ExitProcedure:

    Exit Function

'****************************
'*  Error Recovery Section  *
'****************************
        
ErrHandler:
        
Err.Raise Err.Number,"BuildWhereClause_ListBox" & ";" & Err.Source,Err.Description

End Function

 

[PHV]

Replace this:
strFilter = "[LAST_NAME] " & strLAST_NAME & _
" AND [CREDENTIAL_TYPE] " & strCREDENTIAL_TYPE & _
" AND [OCCUPATION_TYPE] " & strOCCUPATION_TYPE & _
" AND [TRAINING_TYPE] " & strTRAINING_TYPE
By this:
strFilter = "Nz([LAST_NAME]) " & strLAST_NAME & _
" AND Nz([CREDENTIAL_TYPE]) " & strCREDENTIAL_TYPE & _
" AND Nz([OCCUPATION_TYPE]) " & strOCCUPATION_TYPE & _
" AND Nz([TRAINING_TYPE]) " & strTRAINING_TYPE


Hope This Helps, PH.
Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884 or FAQ222-2244

 

[amy3000]

It works! Now I don't really need the Last_Name list (not that it did what I wanted it to do anyway). I'll play with this a little with more parameters. Now the next hard part is creating a report.

But I'm still wondering about the DAO ADO thing. Will it be an issue putting this database on other computers?

 

[PHV]

Don't worry, DAO is still alive ...
Simply don't forget to fully qualify your objects, eg:
Dim rst As DAO.Recordset

Hope This Helps, PH.
Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884 or FAQ222-2244

 

[amy3000]

Now I have another problem. Each individual can have multiple records in each of the list boxes (except credential where they have to select one only. Credential are in the person_ID table). So what I had done was create a query with a left join from the person_ID table to the other tables. However a report based on that query would have bunches of duplicates to show all the data. I then created a report with data from the person ID table eg. name, address, email,credential, etc. I then created several subreports based on the other tables, Training and Occupation currently. I don't understand what's going on because it seemed to be working before. I'm getting duplicate records now on the report when eg. I ask for registered nurses who have HAZMAT training, because she may have several "unlicensed experiences". I want to add more lists, Language, Work Setting--but then the query gets huge with thousands of records.

What I want to do is say, show me the people who meet the criteria I've selected in these multi-select list boxes but don't show me the fields the lists come from. I want that information to come from the subreports. The subreports show more than I want but it works.

I've spent hours and hours on this but I feel like I'm so close. I'm not sure this is clear so I put the database up on my web space if anyone is willing to look at it. I've deleted most objects from this copy. I've gotten rid of all identifying information of the people in it (only 25 now). Their names are all Smith Smith Smith, etc. The query is ZqMulti, the form is Z_THIS_FORM, the report is rptMulti and then several subreports. The report is totally amateur and ugly but I was pretty thrilled to cram all the info they want on it. I'm not so concerned about it. The database is at

http://www.peacefuldriver.net/database/

I am so grateful for Tek-Tips. Sometimes I think this and other technical forums are sanity itself. Off for a little sanity break now too. Thanks.