multi-select answer

[needhelplol]

i have found a way of using a multi-select box, entering data into a database, and then pulling it back out into a from,
hope this helps someone

Private Sub Form_Current()
    'Deselect old values
    Dim varItem As Variant
    For Each varItem In List8.ItemsSelected
            List8.Selected(varItem) = False
    Next
    
    'Call Update List
    Update_List
    
End Sub

Private Sub Update_List()
''retive data stored in database

'S = Genre Values in table as array
Dim S As Variant
'Loop counter
Dim X As Variant
'lower and upper array values
Dim l As Variant
Dim u As Variant
'Genre_values
Dim Values As String

'check to see if database already has values stored in it
gen = IsNull(Genre.Value)
If gen = True Then
Else
    'if yes, then spilt values
    Values = Genre.Value
    S = Split(Values)
    l = LBound(S)
    u = UBound(S)
    
    'select correct items on the form
    For X = 0 To List8.ListCount - 1
    For y = 0 To UBound(S)
        If (Val(List8.ItemData(X)) = Val(S(y))) Then
            List8.Selected(X) = True
        End If
    Next y
    Next X
End If


End Sub

Sub List8_AfterUpdate()
'' add data to database
 Dim strQuery As String
 Dim varItm As Variant
 Dim test As Variant
 Dim First As Integer
 Dim Last As Integer
 Dim i As Integer
 Dim j As Integer
 Dim Temp As Variant
 Dim List As String
 
 For Each varItm In List8.ItemsSelected
    strQuery = strQuery + List8.ItemData(varItm) + " "
 Next varItm
 
 strQuery = Trim(strQuery)
 
 'sort listings
 qry = Split(strQuery, " ")
    First = LBound(qry)
    Last = UBound(qry)
    For i = 0 To Last - 1
        For j = i + 1 To Last
            If qry(i) > qry(j) Then
                Temp = qry(j)
                test(j) = qry(i)
                test(i) = Temp
            End If
        Next j
    Next i
     
    For i = 0 To UBound(qry)
        List = List & " " & qry(i)
    Next

 List = Trim(List)
 Genre.Value = List
 
 'call update_list to check data has been enterd correctly
 Update_List

 
End Sub

this was a little dvd collection database i was creating for my self, "genre" is a field in "dvd" table, list8 is the list box on the form, the form_current is being used as it kept the previous selected items as you moved between records.
hope everything else is understandable

 

[fneily]

Your sort is good for small lists, such as you probably have, but will hog resources and time for large lists. For interest, you may want to see:
Advanced Ideas using VBA - 7.7 Sort an Array in VBA

http://www.aspfree.com/c/a/Microsoft-Access/Advanced-Ideas-using-VBA/1/

Keeping a "value list" in a field in a record in a table in Access, a relational database. Doesn't that go against the protocals of Codd's normalization theory?

 

[MajP]

Although this is useful code, I agree with fneily you are suggesting to create a non-normalized db. You can get this same type of control and have a normalized structure.

Since genre and DVDs have a many to many relationship I made a junction table which holds the foriegn keys.

jncTblDVD_Genre
dvdID_FK
genreID_FK

1) On current: Remove old selections. Use a query to return the applicable selections. Hilite the selections for that DVD

2) On the listbox before update.
If you unselected the genre delete it from the junction table.
If you selected the genre add it to the junction table

Private Sub Form_Current()
  Call clearList
  If Not IsNull(Me.dvdID) Then
    Call HiliteList(Me.dvdID)
  End If
End Sub

Private Sub List4_AfterUpdate()
  Dim lstbx As Access.ListBox
  Set lstbx = Me.List4
  
  If lstbx.Selected(lstbx.ListIndex) Then
    Call addToJncTable(Me.dvdID, lstbx.ItemData(lstbx.ListIndex))
  Else
    Call RemoveFromJnctable(Me.dvdID, lstbx.ItemData(lstbx.ListIndex))
  End If

End Sub

Public Sub addToJncTable(dvdID As Integer, genreID As Integer)
  Dim strSql As String
  strSql = "INSERT INTO jncTblDVD_Genre (dvdID_FK,genreID_FK) VALUES (" & dvdID & "," & genreID & ") "
  DoCmd.SetWarnings (False)
  DoCmd.RunSQL strSql
  DoCmd.SetWarnings (True)
End Sub

Public Sub RemoveFromJnctable(dvdID As Integer, genreID As Integer)
  Dim strSql As String
  strSql = "Delete * from jncTblDVD_Genre Where dvdID_FK = " & dvdID & " AND genreID_FK = " & genreID
  Debug.Print strSql
  DoCmd.SetWarnings (False)
  DoCmd.RunSQL strSql
  DoCmd.SetWarnings (True)
End Sub

Public Sub HiliteList(dvdID As Integer)
  Dim rs As DAO.Recordset
  Dim strSql As String
  Dim lstbx As Access.ListBox
  Dim counter As Integer
  Set lstbx = Me.List4
  strSql = "Select genreID_FK from jncTblDVD_Genre Where dvdID_FK = " & dvdID
  Set rs = CurrentDb.OpenRecordset(strSql)
  Do While Not rs.EOF
    For counter = 0 To lstbx.ListCount - 1
       If CInt(rs.Fields("genreID_FK")) = CInt(lstbx.ItemData(counter)) Then
       lstbx.Selected(counter) = True
      End If
    Next counter
    rs.MoveNext
  Loop
End Sub

Public Sub clearList()
  Dim varItem As Variant
  For Each varItem In Me.List4.ItemsSelected
    List4.Selected(varItem) = False
  Next varItem
End Sub