Saving multiple selections in a listbox on a form

[Kila]

With regard to the post from Cosmos75:

http://www.access-programmers.co.uk/forums/showthread.php?postid=263408#poststop

This was VERY helpful to me, and quite timely since I need it now and it was only posted a few days ago. However, I am confused about using it for MY purposes. I looked at the sample and the links, and nothing seemed to apply. I want to save my multiple selections, in seperate fields, for a survey database where the survey question can have several answers. I won't go into the gory details unless you tell me you need them. but the I have TRIED to set this thing up properly, in a normalized fashion. The Questions and answers are linked by a network of relationships (see attached). I want to save a new record in the Results Table for each selection in the listbox. I know this is pretty basic, but the SAVING part did not seem clear to me from the examples. Thanks for posting this information, Cosmos!!!

 

[Cosmos75]

What version of Access are you using? It would help if you could post a your database (zipped file) with some dummy data. Be sure to compact it so that it is as small as possible since we have a 100 KB file size limit here.

 

[Kila]

Sort-of sample...

I am using Access 97, although I DO have 2000. The intended user only has 97. I have tried to shrink the darn thing down, but I just cannot get it down to 100KB. The last time I tried, I got it down to 198K & still have it function as it is supposed to. There are just too many interconnected tables, queries, forms, and subforms. I have attached just a little mini test sample of a portion of a form. Is this enough?

 

[Cosmos75]

Here's something to help get you started. Post back with any questions. Not exactly what you have but close I think. Not quite sure I am totally understod what you are trying to do.

If I totally missed the mark, post abck and explain waht I did wrong and we'll take it from there.

 

[Kila]

Not quite...

Thanks, but that was not quite it. I can't send you the real thing, because it is too complex and just too BIG! However, here is a screen print of the survey with a picture of what I am trying to do. I want to use "Ctrl" to select multiple answers and save them in the underlying table in seperate records. THANKS for your help!

 

[Cosmos75]

Thanks, but that was not quite it.

We'll get it right! How is it wrong? It does store the multiple answers selected from the ListBox as individual records in tblAnswers. How is that different from what you are trying to accomplish? Are you trying to have the listbox show the selected answers for each question (even when you move between questions)?

Question: Are the available answers (from tblAnswerList) always the same for each question? Or are there only certain valid answers for a question? From your table design, it looks like the answers from tblAnswerList are all valid answers for each question.

 

[Kila]

We'll get it right! How is it wrong? It does store the multiple answers selected from the ListBox as individual records in tblAnswers. How is that different from what you are trying to accomplish?

I'm sorry, maybe it was right. The restructuring of the answer format might have thrown me off. However, it did not seem that it would allow me to select more than one answer at a time.

Are you trying to have the listbox show the selected answers for each question (even when you move between questions)?

I'm not sure what your question is here. I would like to only see the answers related to the question we are viewing, and highlight (and save) the selected answers when I pick them, then change answers when I go to the next question.

Question: Are the available answers (from tblAnswerList) always the same for each question? Or are there only certain valid answers for a question? From your table design, it looks like the answers from tblAnswerList are all valid answers for each question.

Yes, only valid answers for a particular question. This is based on a query that pulls only the answers related to a particular question.

 

[Kila]

It should pretty much look like the screen shot I sent (unless we have to restructure it to make it work), but save the selected multiple answers. That answers box USED to be a combo box that just saved one answer to tblResults by way of qryActiveAnswers, but now they have generated a survey that ask folks to "mark all that apply", so I need to be able to create more than one record at a time.

 

[Kila]

OH! Now I see! I was clicking in the wrong place!

Now I see! I was clicking in the wrong place on what you sent! I was trying to use the combo boxes. Yes, you are on the right track, plus you give a way to delete erroneous answers. NICE! This is very close, except you should only be able to pick a given answer once. I am not sure what DAO is. How to I USE this?

 

[Cosmos75]

Now I see! I was clicking in the wrong place on what you sent! I was trying to use the combo boxes. Yes, you are on the right track, plus you give a way to delete erroneous answers. NICE! This is very close, except you should only be able to pick a given answer once.

Glad I was "very close" with that. If you need more help getting it just right for your app, post back what isn't working and Ill try to help you out as best as I can.

I am not sure what DAO is. How to I USE this?

This thread served as my introduction to DAO (Thank you, Mile-O-Phile!). Should give you you a good idea of what is going on.

 

[Kila]

Thanks!

Thank you. I am in the process of tweaking as we speak. Where did the SQL come from in the code (I am a bit new to VBA, but learning). I copied in the SQL behind the query that the ListBox uses to pull the appropriate answers. Was that the right thing to use? What is that SQL doing?

 

[Kila]

Never mind that, I see now that's wrong. I am trying to change the table names of what you've got to match what exists in the real db, but how do I make this work with subforms and sub-sub forms?

 

[Kila]

OK. This is my last post of the day. I am on my way home. If you are still there, I will check this when I get home. Thanks so much for your time!!! I have tweaked the code for my survey and now have the following error:

Error Number: 3061Error Description: Too few parameters
Expected 1.Error Source: DAO.Database

Here is the tweaked code (the red items I changed, and the green items I REMed out since I am not using the visible fields) :

Private Sub cboAnswerID_Click()
On Error GoTo ErrMsg:

'Code adapted from ghudson's example on
'http://www.access-programmers.co.uk/forums/showthread.php?s=&threadid=52736

Dim myFrm As Form, myCtl As Control
Dim mySelection As Variant
Dim iSelected, iCount As Long
Dim strSQLCount As String (it told me this was not declared. Should this be a string?)

Dim myDB As DAO.Database
Dim myRst As DAO.Recordset
Dim myRstCount As DAO.Recordset

Set myDB = CurrentDb()
Set myRst = myDB.OpenRecordset("qrySurveyAnswers")

'Set myForm to this form (frmMultiSelectListBox)
Set myFrm = Me
'Set myCtl to listbox
Set myCtl = Me.cboAnswerID

iCount = 0
'Count number of selected records/items
For Each mySelection In myCtl.ItemsSelected
iCount = iCount + 1
Next mySelection

'Check if anything is slected
If iCount = 0 Then
MsgBox "There are no answers selected..", _
vbInformation, "Nothing selected!"
Exit Sub
End If

strSQLCount = "SELECT qryActiveAnswers.QuestionID, Count(qryActiveAnswers.AnswerID)" & _
"AS CountOfAnswerListID " & _
"FROM qryActiveAnswers " & _
"GROUP BY qryActiveAnswers.QuestionID " & _
"HAVING (((qryActiveAnswers.QuestionID)= " & _
[Forms]![frmSurvey]![subActiveSurvey]![subActiveQuestion]![txtQuestionID] & "));"

Set myRstCount = myDB.OpenRecordset(strSQLCount, dbOpenSnapshot)
'See if there are any existing answers
If myRstCount.RecordCount <> 0 Then
MsgBox "Already have " & myRstCount.Fields("CountOfAnswerListID") & " answers!", vbCritical, "Already answered..."
If MsgBox("Delete current answers and update with new answers?", vbYesNo + vbQuestion, "Delete?") = vbYes Then
'Delect existing answers
DoCmd.RunSQL ("DELETE qryActiveAnswers.QuestionID " & _
"FROM qryActiveAnswers " & _
"WHERE (((qryActiveAnswers.QuestionID)=" & _
[Forms]![frmSurvey]![subActiveSurvey]![subActiveQuestion]![txtQuestionID] & "));")

Else
MsgBox "Will not add answers at this time. Existing answers were not deleted.", vbInformation, "No changes..."
Exit Sub
End If
End If

iCount = 0

'Go throught each selected 'record' (ItemsSelected) in listbox
For Each mySelection In myCtl.ItemsSelected
'Current count of selected items
iCount = iCount + 1
'Print value to Immediate Window
'Debug.Print myCtl.ItemData(mySelection)
'Add answers
'With myRst
'.AddNew
'.Fields("QuestionsID") = Forms![frmSurvey]![QuestionsID]
'.Fields("AnswerNum") = iCount
'.Fields("AnswerListID") = myCtl.ItemData(mySelection)
'.Update
'End With
Next mySelection

'Requery form
Me.Requery

ResumeHere:
Exit Sub

ErrMsg:
MsgBox "Error Number: " & Err.Number & _
"Error Description: " & Err.Description & _
"Error Source: " & Err.Source, vbCritical, "Error!"
Resume ResumeHere:

End Sub

 

[Cosmos75]

OK. This is my last post of the day. I am on my way home. If you are still there, I will check this when I get home. Thanks so much for your time!!! I have tweaked the code for my survey and now have the following error:

"Error Number: 3061Error Description: Too few parameters
Expected 1.Error Source: DAO.Database"

See this knowledge base article # 209203. It sounds like your query qrySurveyAnswers has a parameter in it, probably based on the QuestionID currently showing on the form. So you will have to specify the parameter in the code (see link) or just run the SQL in code like I did.

]Dim strSQLCount As String (it told me this was not declared. Should this be a string?)

Sorry about that. Yes, it should be a string. It is ALWAYS a good idea to Dim ALL variables.

Am glad I could help.

 

[Kila]

Just as an FYI, I realized that I should NOT have REMed this out, as this is giving what I asked for to start with! I thought this triggered the DIPLAY of the new records, but this is CREATING them. Therefore, the REMed out code becomes:

'Go throught each selected 'record' (ItemsSelected) in listbox
For Each mySelection In myCtl.ItemsSelected
Current count of selected items
iCount = iCount + 1
'Print value to Immediate Window
'Debug.Print myCtl.ItemData(mySelection) (I don't think I need THAT though)
'Add answers
With myRst
.AddNew
.Fields("QuestionID") = Forms![frmSurvey]![QuestionsID]
.Fields("AnswerNum") = iCount
.Fields("AnswerID") = myCtl.ItemData(mySelection)
.Update
End With
Next mySelection

...or something like that. (I think AnswerNum should be named something else, but I'll look at it in the AM. Thank's for all your helo!

 

[Kila]

Hmmmm.

I added the QueryDef as the link you attached suggested (along with theo other "Syntax to set the value of a parameter", but I am still getting the same message. I am relatively new to VBA, so I'm swimming in mud here. What could I be doing wrong? Do you think the references to the sub-sub form could be throwing it off (in red)? Here is the new code below...

Private Sub cboAnswerID_Click()
On Error GoTo ErrMsg:

'Code adapted from ghudson's example on
'http://www.access-programmers.co.uk/forums/showthread.php?s=&threadid=52736

Dim myFrm As Form, myCtl As Control
Dim mySelection As Variant
Dim iSelected, iCount As Long

Dim myDB As DAO.Database
Dim myRst As DAO.Recordset
Dim myRstCount As DAO.Recordset
Dim qdfMyQuery As DAO.QueryDef
Dim strSQLCount As String

Set myDB = CurrentDb()
Set qdfMyQuery = myDB.QueryDefs("qrySurveyAnswers")
qdfMyQuery![Forms!frmSurvey!subActiveSurvey!subActiveQuestion!txtQuestionID] = _
Forms![frmSurvey]![subActiveSurvey]![subActiveQuestion]![txtQuestionID]

Set myRst = myDB.OpenRecordset("qrySurveyAnswers")
'Set myForm to this form (frmMultiSelectListBox)
Set myFrm = Me
'Set myCtl to listbox
Set myCtl = Me.cboAnswerID

iCount = 0
'Count number of selected records/items
For Each mySelection In myCtl.ItemsSelected
iCount = iCount + 1
Next mySelection

'Check if anything is slected
If iCount = 0 Then
MsgBox "There are no answers selected..", _
vbInformation, "Nothing selected!"
Exit Sub
End If

strSQLCount = "SELECT qryActiveAnswers.QuestionID, Count(qryActiveAnswers.AnswerID)" & _
"AS CountOfAnswerListID " & _
"FROM qryActiveAnswers " & _
"GROUP BY qryActiveAnswers.QuestionID " & _
"HAVING (((qryActiveAnswers.QuestionID)= " & _
[Forms]![frmSurvey]![subActiveSurvey]![subActiveQuestion]![txtQuestionID] & "));"

Set myRstCount = myDB.OpenRecordset(strSQLCount, dbOpenSnapshot)
'See if there are any existing answers
If myRstCount.RecordCount <> 0 Then
MsgBox "Already have " & myRstCount.Fields("CountOfAnswerListID") & " answers!", vbCritical, "Already answered..."
If MsgBox("Delete current answers and update with new answers?", vbYesNo + vbQuestion, "Delete?") = vbYes Then
'Delect existing answers
DoCmd.RunSQL ("DELETE qryActiveAnswers.QuestionID " & _
"FROM qryActiveAnswers " & _
"WHERE (((qryActiveAnswers.QuestionID)=" & _
[Forms]![frmSurvey]![subActiveSurvey]![subActiveQuestion]![txtQuestionID] & "));")
Else
MsgBox "Will not add answers at this time. Existing answers were not deleted.", vbInformation, "No changes..."
Exit Sub
End If
End If

iCount = 0

'Go throught each selected 'record' (ItemsSelected) in listbox
For Each mySelection In myCtl.ItemsSelected
'Current count of selected items
iCount = iCount + 1
'Print value to Immediate Window
'Debug.Print myCtl.ItemData(mySelection)
'Add answers
With myRst
.AddNew
.Fields("QuestionID") = Forms![frmSurvey]![subActiveSurvey]![subActiveQuestion]![txtQuestionID]
.Fields("AnswerNum") = iCount
.Fields("AnswerID") = myCtl.ItemData(mySelection)
.Update
End With
Next mySelection

'Requery form
Me.Requery

qdfMyQuery.Close
myDB.Close

ResumeHere:
Exit Sub

ErrMsg:
MsgBox "Error Number: " & Err.Number & _
"Error Description: " & Err.Description & _
"Error Source: " & Err.Source, vbCritical, "Error!"
Resume ResumeHere:

End Sub

 

[Cosmos75]

Does this work?

Syntax to refer to textbox on a sub-sub-form (my terminoligy! ).
Forms![Form1]![Form2].Form![From 3].Form![Text1]

qdfMyQuery![Forms!frmSurvey!subActiveSurvey!subActiveQuestion!txtQuestionID] =
Forms![frmSurvey]![subActiveSurvey].Form![subActiveQuestion].Form![txtQuestionID]

or

qdfMyQuery![Forms!frmSurvey!subActiveSurvey.Form!subActiveQuestion.Form!txtQuestionID] =
Forms![frmSurvey]![subActiveSurvey].Form![subActiveQuestion].Form![txtQuestionID]

See here for some guidance to using the ! notation. I'm not good at it at all. I always use the query builder to help me get the right syntax.

 

[Kila]

Thanks for trying..

Thanks for trying, but no. We are getting closer though! I am still trying to tweak the thing! Your 1st code gave the same message as before, Too few parameters. NOW, we are getting a different message with your SECOND code. Hallelujah! At least I know the machine is not ignoring me! Here is the new message...

Error Number: 3265Error Description: Item not found in this
collection.Error Source: DAO.Parameters

I am thinking that it does not like what I am selecting. What I mean is, what I am SELECTING (remember the screen shot I sent, where I picked several TEXT PHRASES) is not what is being queried or saved, which is the ID# associated with the text phrase. (Obviously, this is not what is displayed, because no one knows what AnswerID "84" is) Do you think that could be it? How do I get around that?

 

[Kila]

Fyi..

Just as an FYI, here is the Row Source from the List Box:

SELECT DISTINCTROW [qrySurveyAnswers].[AnswerID], [qrySurveyAnswers].[Answer] FROM [qrySurveyAnswers];

[qrySurveyAnswers].[Answer] is the text displayed,
[qrySurveyAnswers].[AnswerID] is the result of the query and the number that is saved in the record, but the user never sees this number.

 

[Kila]

Would you mind sending a little additional guidance?

I hate to keep bugging you, but I am in a bit over my head. I am just learning VBA and I am not quite sure what I am doing. I have been working on this & trying to figure out how to fix it, but I am still getting an error message:

Error Number: 3265Error Description: Item not found in this
collection.Error Source: DAO.Parameters

I have an idea what is wrong, but I am not sure how to go about fixing it because I am not sure what each part of the code does to know where to start fixing the problem. I also do not completely understand the interaction between the virtual DAO database and the real one.

Right now, my primary question is this (I think this may be part of the problem): The selected answers are supposed to be saved to qrySavedAnswers, but I am not sure if the code is correctly referencing this everywhere. The query that provides the listbox answers is qryActiveAnswers. I am not sure how to make these (and the other queries) interact properly with the DAO. I would appreciate it if you would look at this code and see if it at lease LOOKS right. I really think I am missing something minor, and I worry that I am messing the thing up worse trying to fix it. As always, thanks for ALL your help!!

Private Sub cboAnswerID_Click()
On Error GoTo ErrMsg:

    'Code adapted from ghudson's example on
    'http://www.access-programmers.co.uk/forums/showthread.php?s=&threadid=52736

    Dim myFrm As Form, myCtl As Control
    Dim mySelection As Variant
    Dim iSelected, iCount As Long
 
    Dim myDB As DAO.Database
    Dim myRst As DAO.Recordset
    Dim myRstCount As DAO.Recordset
    Dim qdfMyQuery As DAO.QueryDef
    Dim strSQLCount As String
       
    Set myDB = CurrentDb()
    Set qdfMyQuery = myDB.QueryDefs("qrySavedAnswers")
    '1st try - Didn't work
            'Error message:     Error Number: 3061Error Description: Too few parameters
                                'Expected 1.Error Source: DAO.Database
    'qdfMyQuery![Forms!frmSurvey!subActiveSurvey!subActiveQuestion!txtQuestionID] = _
    '    Forms![frmSurvey]![subActiveSurvey]![subActiveQuestion]![txtQuestionID]
    
    '2nd try - Didn't Work
            'Error message:     Error Number: 3061Error Description: Too few parameters
                                'Expected 1.Error Source: DAO.Database
    'qdfMyQuery![Forms!frmSurvey!subActiveSurvey!subActiveQuestion!txtQuestionID] = _
    '    Forms![frmSurvey]![subActiveSurvey].Form![subActiveQuestion].Form![txtQuestionID]
        
    '3rd try - Didn't work..Different error message!
            'Error message:     Error Number: 3265Error Description: Item not found in this
                                'collection.Error Source: DAO.Parameters
    qdfMyQuery![Forms!frmSurvey!subActiveSurvey.Form!subActiveQuestion.Form!txtQuestionID] = _
        Forms![frmSurvey]![subActiveSurvey].Form![subActiveQuestion].Form![txtQuestionID]

    Set myRst = myDB.OpenRecordset("qrySavedAnswers")
    'Set myRst = myDB.OpenRecordset("qrySurveyAnswers")  (Didn't work)
    'Set myForm to this form (frmMultiSelectListBox)
    Set myFrm = Me
    'Set myCtl to listbox
    Set myCtl = Me.cboAnswerID
    
    iCount = 0
    'Count number of selected records/items
    For Each mySelection In myCtl.ItemsSelected
        iCount = iCount + 1
    Next mySelection
    
    'Check if anything is selected
    If iCount = 0 Then
        MsgBox "There are no answers selected..", _
        vbInformation, "Nothing selected!"
        Exit Sub
    End If
       
       strSQLCount = "SELECT qrySavedAnswers.QuestionID, Count(qrySavedAnswers.AnswerID)" & _
       "AS CountOfAnswerListID " & _
       "FROM qrySavedAnswers " & _
       "GROUP BY qrySavedAnswers.QuestionID " & _
       "HAVING (((qrySavedAnswers.QuestionID)= " & _
       [Forms]![frmSurvey]![subActiveSurvey]![subActiveQuestion]![txtQuestionID] & "));"
    
    Set myRstCount = myDB.OpenRecordset(strSQLCount, dbOpenSnapshot)
    'See if there are any existing answers
    If myRstCount.RecordCount <> 0 Then
        MsgBox "Already have " & myRstCount.Fields("CountOfAnswerListID") & " answers!", vbCritical, "Already answered..."
        If MsgBox("Delete current answers and update with new answers?", vbYesNo + vbQuestion, "Delete?") = vbYes Then
            'Delect existing answers
            DoCmd.RunSQL ("DELETE qrySavedAnswers.QuestionID " & _
                            "FROM qrySavedAnswers " & _
                            "WHERE (((qrySavedAnswers.QuestionID)=" & _
                            [Forms]![frmSurvey]![subActiveSurvey]![subActiveQuestion]![txtQuestionID] & "));")
        Else
            MsgBox "Will not add answers at this time.  Existing answers were not deleted.", vbInformation, "No changes..."
            Exit Sub
        End If
    End If
    
   iCount = 0

    'Go throught each selected 'record' (ItemsSelected) in listbox
    For Each mySelection In myCtl.ItemsSelected
        'Current count of selected items
        iCount = iCount + 1
    'Print value to Immediate Window
        'Debug.Print myCtl.ItemData(mySelection)
    'Add answers
        With myRst
            .AddNew
            .Fields("QuestionID") = Forms![frmSurvey]![subActiveSurvey]![subActiveQuestion]![txtQuestionID]
            '.Fields("AnswerNum") = iCount
            .Fields("AnswerID") = myCtl.ItemData(mySelection)
            .Fields("SurveyID") = Forms![frmSurvey]![subActiveSurvey]![txtSurveyID]
            .Fields("CompletedSurveyID") = Forms![frmSurvey]![txtCompletedSurveyID]
            .Update
        End With
    Next mySelection
        
    'Requery form
    Me.Requery

qdfMyQuery.Close
myDB.Close

ResumeHere:
    Exit Sub

ErrMsg:
    MsgBox "Error Number: " & Err.Number & _
           "Error Description: " & Err.Description & _
           "Error Source: " & Err.Source, vbCritical, "Error!"
    Resume ResumeHere:

End Sub