Moving or copying from listbox A to listbox B

[Thingol]

Hi all,

I am trying to create a selection tool in my contacts database. I have a form in which I can fill a listbox (lstZoekResultaat) with the results from a custom search that's based on text entered in some textboxes/comboboxes.

This all works as it should!

Now I want to be able to create a second listbox (lstSelectie) to which a user can move items that he has selected in lstZoekResultaat. I tried using the code in the FAQ702-4246.

I adapted all the names of listboxes and buttons in the FAQ code, to fit my form. I have remmed out the closeform statements and all but one of the closeform statements (I only left the Reset buttons instruction). I'm not posting the code, I hope the FAQ code, together with my comments will be sufficient.

I get an error message upon running the code:

Runtime error 9:
Subscript out of range
(This was loosely translated from Dutch, so it may not be literal.)

I get the error both in the routine cmdSelect_Click() as in the routine cmdSelectAll_Click(), and the error shows in this line:

    For i = 0 To nRows * nCols - 1
[highlight]        astrTo(iTo + i) = astrFrom(i)[/highlight]
    Next i

I think it may have to do with the fact that my "From Listbox" has a code generated query as rowsource. I also think this may prevent the Deselect and DeselectAll codes from running correctly, although I haven't tested these yet.

Can anyone help me on starting to solve this? I am not sure where to begin. If more code is needed, please let me know, I didn't want to overinform everyone with all the code in the form.

Thanks a lot in advance for any help! It will be greatly appreciated.

Best regards,
Martijn Senden.

In the Beginning there was nothing, which exploded.

--Terry Pratchett, Lords and Ladies--

 

[Thingol]

Hi all,

It may be hard to answer my question (see 1st post) without the code in my form. Here's the code (sorry, it's quite a lot):

Option Compare Database
Option Explicit

Public Sub Selecteer()
'Set the Dimensions of the Module
Dim strSQL As String, strOrder As String, strWhere As String
Dim strSQL2 As String
Dim dbNm As Database
Dim qryDef As QueryDef
Dim strTabel As String
Set dbNm = CurrentDb()

'Select statements for the RowSource
If Me.Groep = 18 Or IsNull(Me.Groep) = True Then
  strSQL = "SELECT * FROM tblPersoonsgegevens"
  'Where clause if no group is selected
  strWhere = "WHERE"
  strOrder = "ORDER BY tblPersoonsgegevens.Bedrijf, tblPersoonsgegevens.Achternaam;"
  strTabel = "tblPersoonsgegevens"
Else
  strSQL = "SELECT * FROM tblPersoonsgegevens C INNER JOIN tblPersonen_En_Groepen CM ON C.PersoonID=CM.PersoonID"
  'Where clause if a group is selected
  strWhere = "WHERE CM.GroepID=" & Me![Groep] & "   AND"
  strOrder = "ORDER BY C.Bedrijf, C.Achternaam;"
  strTabel = "C"
End If
  
'Set the WHERE clause for the Listbox RowSource if information has been entered into a field on the form
If Not IsNull(Me.Voornaam) Then '<--If the textbox txtFName contains no data THEN do nothing
   strWhere = strWhere & " (" & strTabel & ".Voornaam) Like '*" & Me.Voornaam & "*'  AND" '<--otherwise, apply the LIKE statment to the QueryDef
End If

If Not IsNull(Me.Achternaam) Then
   strWhere = strWhere & " (" & strTabel & ".Achternaam) Like '*" & Me.Achternaam & "*'  AND"
End If

If Not IsNull(Me.Bedrijf) Then
   strWhere = strWhere & " (" & strTabel & ".Bedrijf) Like '*" & Me.Bedrijf & "*'  AND"
End If

If Not IsNull(Me.Land) Then
   strWhere = strWhere & " (" & strTabel & ".Land_Werk) Like '*" & Me.Land & "*'  AND"
End If

If Not IsNull(Me.Titel) Then
   strWhere = strWhere & " (" & strTabel & ".Titel) Like '*" & Me.Titel & "*'  AND"
End If

If Not IsNull(Me.Plaats) Then
   strWhere = strWhere & " (" & strTabel & ".Plaats_Werk) Like '*" & Me.Plaats & "*'  AND"
End If

If Not IsNull(Me.Afdeling) Then
   strWhere = strWhere & " (" & strTabel & ".Afdeling) Like '*" & Me.Afdeling & "*'  AND"
End If

'If Not IsNull(Me.Groep) Then
'   strWhere = strWhere & " (tblPersonen_En_Groepen.Naam_groep) Like '*" & Me.Groep & "*'  AND"
'   strWhere = strWhere & " (tblPersonen_En_Groepen.PersoonID) Like tblPersoonsgegevens.PersoonID AND  "
'End If

'Remove the last AND from the SQL statment
strWhere = Mid(strWhere, 1, Len(strWhere) - 5)

'Pass the SQL to the subform
Set qryDef = dbNm.QueryDefs("qrySelecteren")
qryDef.SQL = strSQL & " " & strWhere & "" & strOrder
Dim rsCnt As Variant
rsCnt = DCount("[" & strTabel & ".PersoonID]", "qrySelecteren")
Dim Subfrm As Control
Set Subfrm = Me!subSelecteren
DoCmd.Requery Subfrm.Name
Me.subSelecteren.Form.RecordSource = Me.subSelecteren.Form.RecordSource
Me.lstZoekResultaat.RowSource = strSQL & " " & strWhere & "" & strOrder
If rsCnt = 0 Then
  MsgBox "Geen contactpersonen gevonden", vbOKOnly, "Geen gegevens gevonden"
End If
End Sub

Private Sub cmdWissen_Click()
Me.Groep.Value = 18
Me.Voornaam.Value = Null
Me.Achternaam.Value = Null
Me.Titel.Value = Null
Me.Plaats.Value = Null
Me.Land.Value = Null
Me.Bedrijf.Value = Null
Me.Afdeling.Value = Null
Call Selecteer
End Sub

Private Sub Groep_AfterUpdate()
Call Selecteer
End Sub

Private Sub Voornaam_AfterUpdate()
Call Selecteer
End Sub

Private Sub Achternaam_AfterUpdate()
Call Selecteer
End Sub

Private Sub Titel_AfterUpdate()
Call Selecteer
End Sub

Private Sub Plaats_AfterUpdate()
Call Selecteer
End Sub

Private Sub Land_AfterUpdate()
Call Selecteer
End Sub

Private Sub Bedrijf_AfterUpdate()
Call Selecteer
End Sub

Private Sub Afdeling_AfterUpdate()
Call Selecteer
End Sub

Private Sub cmdSelecteer_Click()
Call Selecteer
End Sub

' Description:
' This form demonstrates how to use a pair of list boxes to select any number
' of items from a list. The list boxes MUST have their RowSourceType property
' set to "Value list", and must have the same value for the ColumnCount property.

Private Sub cmdDeselecteren_Click()
    ' The button received the focus when it was clicked. If we move the last
    ' item in the list, this button must be disabled, but you can't disable a
    ' button when it has the focus, so always set the focus to the list box.
    ' We do much the same thing for the other command buttons.
    lstSelectie.SetFocus
    DeselectItem
End Sub

Private Sub cmdAllesDeselecteren_Click()
    lstSelectie.SetFocus
    DeselectAllItems
End Sub

Private Sub cmdSelecteren_Click()
    lstZoekResultaat.SetFocus
    SelectItem
End Sub

Private Sub cmdAllesSelecteren_Click()
    lstZoekResultaat.SetFocus
    SelectAllItems
End Sub

Private Sub Form_Open(Cancel As Integer)
    ' Load the list boxes. In a real-world application you would probably not
    ' use constants, but would build up the list of semicolon-separated items
    ' in a string.
'    LoadList lstZoekResultaat, List1
'    LoadList lstSelectie, List2
    ResetButtons
End Sub

Private Sub lstZoekResultaat_DblClick(Cancel As Integer)
' Double-clicking an item in a list moves it to the other list
    SelectItem
End Sub

Private Sub lstSelectie_DblClick(Cancel As Integer)
    DeselectItem
End Sub

Private Sub SelectItem()
    MoveItem lstZoekResultaat, lstSelectie
    ResetButtons
End Sub

Private Sub SelectAllItems()
    MoveAllItems lstZoekResultaat, lstSelectie
    ResetButtons
End Sub

Private Sub DeselectItem()
    MoveItem lstSelectie, lstZoekResultaat
    ResetButtons
End Sub

Private Sub DeselectAllItems()
    MoveAllItems lstSelectie, lstZoekResultaat
    ResetButtons
End Sub

Private Sub ResetButtons()
' This procedure enables or disables the command buttons. Buttons that move
' items out of a list are disabled if the list is empty, else they are enabled.
    cmdSelecteren.Enabled = lstZoekResultaat.ListCount > 0
    cmdAllesSelecteren.Enabled = cmdSelecteren.Enabled
    cmdDeselecteren.Enabled = lstSelectie.ListCount > 0
    cmdAllesDeselecteren.Enabled = cmdDeselecteren.Enabled
End Sub

' The following procedures are parameterized to make them independent of any
' form. If you want to use the dual list box method in multiple forms, you
' could make these procedures Public and put them in a standard module. That
' would make the database smaller and let the forms load faster.

Private Sub MoveItem(FromListBox As ListBox, ToListBox As ListBox)
' Moves an item from the FromListBox to the ToListBox. After the move, the
' moved item is selected in the 'to' list box, and the item following the
' moved item, if there is one, is selected in the 'from' list box (otherwise
' the first item is selected).
    Dim nCols As Integer        ' Number of columns in each list box
    Dim iFrom As Integer        ' Index of current item in source list box
    Dim iTo As Integer          ' Index of current item in target list box
    Dim astrFrom As Variant     ' Array of strings from source RowSource
    Dim astrTo As Variant       ' Array of strings from target RowSource
    Dim i As Integer
    
    ' Check that some item is selected in the source list box. (If no item is
    ' selected, the ListIndex property is -1.)
    If FromListBox.ListIndex < 0 Then Exit Sub
        
    nCols = FromListBox.ColumnCount
    MsgBox (nCols)
    
    ' Unload the list box contents into string arrays. If the list boxes have
    ' multiple columns, the arrays will contain the values from R0C0, R0C1,
    ' R0C2, ... R1C0, R1C1, R1C2, etc.
    astrFrom = Split(FromListBox.RowSource, ";")
    ' Note: For the target list box, we append extra ";"s to the RowSource
    ' property so that Split() will create entries for an extra item. This
    ' keeps us from having to resize the array to make room for the new item.
    astrTo = Split(ToListBox.RowSource & String(nCols, ";"), ";")
    
        
    ' Copy the columns of the selected item to the extra item at the end of
    ' the target array.
    iFrom = FromListBox.ListIndex
    iTo = ToListBox.ListCount
    For i = 0 To nCols - 1
        astrTo(iTo * nCols + i) = astrFrom(iFrom * nCols + i)
    Next i
    
    ' Delete the selected item from the source list by shifting any
    ' remaining items down in the array.
    For i = iFrom * nCols To UBound(astrFrom) - nCols
        astrFrom(i) = astrFrom(i + nCols)
    Next i
    
    ' Resize the source array to eliminate the extra item at the end. Note
    ' that the source array may have been emptied; if it is, set it to an
    ' empty array. (ReDim will not create an empty array.)
    If i = 0 Then
        astrFrom = Array()
    Else
        ReDim Preserve astrFrom(i - 1)
    End If
    
    LoadList FromListBox, Join(astrFrom, ";"), iFrom
    LoadList ToListBox, Join(astrTo, ";"), iTo
End Sub

Private Sub MoveAllItems(FromListBox As ListBox, ToListBox As ListBox)
' Moves all items from the FromListBox to the ToListBox. After the move,
' the first item is selected in the 'to' list box.
    Dim nCols As Integer        ' Number of columns in each list box
    Dim nRows As Integer        ' Number of rows in source list box
    Dim iTo As Integer          ' Index of current item in target list box
    Dim astrFrom As Variant     ' Array of strings from source RowSource
    Dim astrTo As Variant       ' Array of strings from target RowSource
    Dim i As Integer
    
    nCols = FromListBox.ColumnCount
    nRows = FromListBox.ListCount
    
    ' Check that the source list box is not empty
    If nRows = 0 Then Exit Sub
    
    ' Unload the list box contents into string arrays. If the list boxes have
    ' multiple columns, the arrays will contain the values from R0C0, R0C1,
    ' R0C2, ... R1C0, R1C1, R1C2, etc.
    astrFrom = Split(FromListBox.RowSource, ";")
    ' Note: For the target list box, we append extra ";"s to the RowSource
    ' property so that Split() will create extra entries for the items to be
    ' moved. This keeps us from having to resize the array to make room for
    ' the new items.
    astrTo = Split(ToListBox.RowSource & String(nRows * nCols, ";"), ";")
    
    ' Copy the 'from' list box items to the extra items at the end of the
    ' target array.
    iTo = ToListBox.ListCount * nCols
'    nRows =
    For i = 0 To nRows * nCols - 1
        astrTo(iTo + i) = astrFrom(i)
    Next i
    
    LoadList FromListBox, ""
    LoadList ToListBox, Join(astrTo, ";"), iTo
End Sub

Private Sub LoadList(ListBox As ListBox, Items As String, _
                     Optional SelectedItem As Integer = 0)
' This procedure loads a list box from a string containing a value list, and
' attempts to make the SelectedItem selected. If SelectedItem is invalid, the
' first item in the list is selected instead.
    With ListBox
        .RowSource = Items
        If SelectedItem < 0 Or SelectedItem >= .ListCount Then _
            SelectedItem = 0
        
        ' If the BoundColumn property is set to 0, you select an item by
        ' setting the list box's value to the desired item number. Otherwise,
        ' you set it to the value of the bound column for the desired item.
        If .BoundColumn = 0 Then
            .Value = SelectedItem
        Else
            .Value = .ItemData(SelectedItem)
        End If
    End With
End Sub

I hope this will help you to answer my question. I can't find out what to do about it. I think the problem is that I use a query for the rowsource. How can I adapt the code, so that it will work in my database?

Thanks again for any help!
Martijn Senden.

In the Beginning there was nothing, which exploded.

--Terry Pratchett, Lords and Ladies--