Multi-select List Boxes

[Rawb]

Just this morning, I've started playing with Multi-select List Boxes and I've come across a couple of questions.



First off, if I'm using one of these new-fangled List Boxes, how do I use it to enter/modify data on multiple Records? Let's look at pentabarf's Firefighter connundrum. . .

Assuming the following Table setup:

Calls:

CallID|Address1|City|Timestamp
1|123 Street St|Somewheresville|=Now()

Members:

MemberID|MemberName
1|Rawb
2|pentabarf
3|TheShabz
4|pbaldy

Tasks:

TaskID|TaskName
1|Driver
2|Pump Operator
3|Salvage

Responders:

CallID|MemberID|TaskID
1|1 (Rawb)|1 (Driver)
1|2 (pentabarf)|2 (Pump Operator)
1|2 (pentabarf)|3 (Salvage)
1|3 (TheShabz)|3 (Salvage)

How would I generate a Multi-select List Box for pentabarf on Call ID #1? He has two Tasks, so how would I code my On Load Event to select those two out of the List Box that shows all the Tasks?

And, assuming someone selects a new task (or deselects a selected one), how would I code the After Update/On Exit Event to handle that?

[pbaldy]

At first this will not seem on point, but the technique can be adapted to what you're doing:

http://support.microsoft.com/default...b;en-us;210203

with this type of thing to generate a list:

Return a concatenated list of sub-record values

[Rawb]

Well, I've figured out the first part of my thingamabobber. . .

I use the following code in my Form's On Load Event to pre-populate the List Box.

Assuming:
Me!CallID is a Hidden Form field with a value passed from the parent/calling Form.
Me!MemberID is a Hidden Form field with a value passed from the parent/calling Form.
Me!Tasks is a ListBox contining all the Records from the Tasks Table (sorted alphabetically)

Private Sub Form_Load()
  ' Well, I do declare!
  Dim rstMembers As DAO.Recordset
  Dim rstResponders As DAO.Recordset
  Dim rstTasks As DAO.Recordset

  ' Set the Recordset to the (Active) Member currently being viewed
  Set rstMembers = CurrentDb().OpenRecordset("SELECT TOP 1 * FROM qryActiveMembers WHERE [MemberID]=" & Me!MemberID, dbOpenSnapshot) ' Read-only

  ' Set the Recordset to a complete list of available Tasks
  Set rstTasks = CurrentDb().OpenRecordset("SELECT * FROM Tasks ORDER BY [TaskName] ASC", dbOpenSnapshot) ' Read-only

  ' Set the Recordset to a list of every Task the current (Active) Member
  ' percormed for the current Call
  Set rstResponders = CurrentDb().OpenRecordset("SELECT * FROM Responders WHERE [CallID]=" & Me!CallID & " AND [MemberID]=" & Me!MemberID, dbOpenSnapshot) ' Read-only

  ' Go to the first Record in the Tasks Recordset
  rstTasks.MoveFirst

  ' Loop through each Record in the Tasks Recordset and perform the following
  ' actions
  For i = 0 To rstTasks.RecordCount - 1
    ' Move (back) to the first Record in the Responders Recordset
    rstResponders.MoveFirst

    ' Loop through each Record in the Responders Recordset and compare that
    ' Task with the currently selected one
    For j = 0 To rstResponders.RecordCount - 1
      ' Check that the currently selected Task matches the Task ID of the
      ' Responder Record
      If rstTasks("TaskID") = rstResponders("TaskID") Then
        ' If it DOES match, highlight the Task as already selected
        Me!Tasks.Selected(i) = True
      End If

      ' Move to the next Responders Record and restart the (inner) loop
      rstResponders.MoveNext
    Next j

    ' Move to the next Tasks Record and restart the (main) loop
    rstTasks.MoveNext
  Next i

  ' Display the (Active) Member's name instead of their ID
  Me!FullName = rstMembers("FullName")

  ' Close the Recordsets
  rstMembers.Close
  rstResponders.Close
  rstTasks.Close

  ' Unset the Recordset Objects
  Set rstMembers = Nothing
  Set rstResponders = Nothing
  Set rstTasks = Nothing
End Sub

Now all I need to do is figure out how to Update the Records when the contents of the List Box changes! Yay!

[pbaldy]

Not how I would have done it, but this type of thing in the after update event of the listbox (either way using ctl.Column(x) to get the listbox value, where x is the appropriate column):

  If (ctl.Selected(ctl.ListIndex)) Then 'if the current item is selected, add it
    rs.AddNew
    ...
    rs.Update
  Else  'otherwise delete it
    CurrentDb.Execute "DELETE * FROM ..."
  End If

[Rawb]

First, my Code was how to highlight the items that should be initially selected when the Form opens and not how to update the Tables when the user adds/removes items from the selection

Second, I'm not sure I follow your code. I was never very good at OOP and this seems dangerously close to that in style

Can you explain more to me about this ctl Object you're using? And how does the program know what's selected or not (you say "if the current item is selected" in your code comments. . . How does the program know what the current item is)?

[Rawb]

OK, I found a better way to iterate through the Tasks for my Form Load Event. Before, I was setting up a Recordset that matched the List Box's contents perfectly. Now, I'm referencing the List Box directly (allowing me to do away with the Recordset).

Form Load Event:

Private Sub Form_Load()
  ' Well, I do declare!
  Dim rstMembers As DAO.Recordset
  Dim rstResponders As DAO.Recordset

  ' Set the Recordset to the (Active) Member currently being viewed
  Set rstMembers = CurrentDb().OpenRecordset("SELECT TOP 1 * FROM qryActiveMembers WHERE [MemberID]=" & Me!MemberID, dbOpenSnapshot) ' Read-only

  ' Set the Recordset to a list of every Task the current (Active) Member
  ' percormed for the current Call
  Set rstResponders = CurrentDb().OpenRecordset("SELECT * FROM Responders WHERE [CallID]=" & Me!CallID & " AND [MemberID]=" & Me!MemberID, dbOpenSnapshot) ' Read-only

  ' Make sure there are actually Tasks to highlight
  If Not rstResponders.RecordCount = 0 Then
    ' Make sure we have an accurate Record count by forcing Access to load the
    ' whole Recordset
    rstResponders.MoveLast
    rstResponders.MoveFirst

    ' Loop through each Record in the Responders Recordset
    For i = 0 To rstResponders.RecordCount - 1
      ' For each Record in the Recordset, loop through the contents of the List
      ' Box (Me!Tasks) to find the matching Task
      For j = 0 To Me!Tasks.ListCount - 1
        ' Check to see if the List Box's current Task matches the one from the
        ' Recordset

        ' NOTE: We have to typecast the List Box contents to an Integer to match
        ' it against the Recordset's value (Why??!?)
        If rstResponders("TaskID") = CInt(Me!Tasks.Column(0, j)) Then
          ' If the Record and List Box item match, highlight the List Box item!
          Me!Tasks.Selected(j) = True

          ' Also highlight the matching item from our Hidden List Box. We can use
          ' this to compare against the "real" one to find changes (See the
          ' After_Update Event)
          Me!Tasks_Orig.Selected(j) = True
        End If
      Next j

      ' Go to the next Record and start the loop over
      rstResponders.MoveNext
    Next i
  End If

  ' Display the Member whose Tasks we are showing (instead of their ID)
  Me!FullName = rstMembers("FullName")

  ' Close the Recordsets
  rstMembers.Close
  rstResponders.Close

  ' Unset the Recordset Objects
  Set rstMembers = Nothing
  Set rstResponders = Nothing
End Sub

And, using my Form Load Event, I was able to throw together the following After Update Event for my List Box which seems to work rather well.

After Update Event:

Private Sub Tasks_AfterUpdate()
  ' Danger Will Robinson! DANGER!!!
  On Error GoTo Error_Will_Robinson

  ' Declare my database Objects
  Dim work As Workspace
  Dim rstResponders As DAO.Recordset

  ' Declare and initialize a variable for tracking the status of the Transaction
  Dim boolTransActive As Boolean
  boolTransActive = False

  ' Set my database Objects
  Set work = DBEngine(0) ' For Transactions!

  ' Set the Recordset to a list of every Task the current (Active) Member
  ' performed for the current Call
  Set rstResponders = CurrentDb().OpenRecordset("SELECT * FROM Responders WHERE [CallID]=" & Me!CallID & " AND [MemberID]=" & Me!MemberID, dbOpenDynaset)

  ' Start the Transaction and switch my tracking variable to True
  work.BeginTrans
  boolTransActive = True

  ' Loop through each item in the List Box
  For i = 0 To Me!Tasks.ListCount - 1
    ' Check each List Box item to see if it is selected or not
    If Me!Tasks.Selected(i) = True Then
      ' If it IS selected (highlighted), then compare it against the hidden List Box
      If Not Me!Tasks_Orig.Selected(i) = True Then
        ' If the same item is NOT selected in the hidden List Box, then it is a
        ' new one and needs to be added to the Responders Table
        With rstResponders
          .AddNew
          !CallID = Me!CallID
          !MemberID = Me!MemberID
          !TaskID = Me!Tasks.Column(0, i)
          .Update
        End With

        ' Mark the hidden List Box's item as selected to allow to more updates
        Me!Tasks_Orig.Selected(i) = True
      End If
    Else
      ' If the List Box item IS NOT selected (highlighted), compare it to the
      ' same item on the hidden List Box
      If Not Me!Tasks_Orig.Selected(i) = False Then
        ' If the hidden List Box's item IS selected, the Task should be REMOVED
        ' from the Responders Table

        ' Find the Record in our Recordset
        strCriteria = "[CallID]= " & Me!CallID & _
                      " And [MemberID]=" & Me!MemberID & _
                      " And [TaskID]=" & Me!Tasks.Column(0, i)
        rstResponders.FindFirst strCriteria

        ' If the Record exists, delete it from the Recordset
        If Not rstResponders.NoMatch Then
          With rstResponders
            .Delete
          End With
        End If

        ' Deselect the hidden List Box's item to allow to more updates
        Me!Tasks_Orig.Selected(i) = False
      End If
    End If
  Next i

  ' Commit the transaction and unset our tracking variable
  work.CommitTrans
  boolTransActive = False

' Function Closing/Cleanup code block
FunctionClosing:
  ' Close the Recordset
  rstResponders.Close

  ' Unset the database Objects
  Set rstResponders = Nothing
  Set work = Nothing

  ' Leave the function so we don't run into an infinite loop!
  Exit Sub

' If an error is encountered, run the following code block
Error_Will_Robinson:
  ' If we're currently in the middle of a Transaction, rollback any changes
  ' made to the database. Don't forget to unset the tracking variable!
  If boolTransActive = True Then
    work.Rollback
    boolTransActive = False
  End If

  ' Display a detailed error message to the user
  MsgBox "The following error was encountered while attempting to update Responder Tasks. Please contact your System's Administrator." & _
         vbCrLf & vbCrLf & _
         Err.Number & ": " & Err.Description

  ' Jump to the Function Closing/Cleanup code block
  Resume FunctionClosing
End Sub

Even though I've figured this out, I'd still like to see how you can use pbaldy's code to perform the same thing. . .

[pbaldy]

First, my Code was how to highlight the items that should be initially selected when the Form opens and not how to update the Tables when the user adds/removes items from the selection

I understood that; I sort of jumped from saying that wasn't how I would have accomplished that to demonstrating the add/remove bit.

Can you explain more to me about this ctl Object you're using? And how does the program know what's selected or not (you say "if the current item is selected" in your code comments. . . How does the program know what the current item is)?

ctl is simply a shortcut to the listbox. Before that was:

Dim ctl As Control
Set ctl = Me.lstCharges

That code was cut right out of a working procedure, so it works as is (well, after filling in the relevant bits). This test

If (ctl.Selected(ctl.ListIndex)) Then

uses the ListIndex property to determine what the current item is. The Selected property will return True or False as appropriate. Again, that was cut out of a working process, so I know it works and will add/delete items as they are selected or deselected by the user.