Solved two separate multiselect lists: appending selections of each list to the same rows of the same table

[WithRegards]

I have the two pictured separate multi-select lists, set to 'Extended':

The list on the left with label 'Select Lock and Key IDs:' is called list_keyIDs and the list on the right with label 'Select Tags' is called listbox_tag_nos.

At the moment I am looping through each item selected in list_keyIDs and appending to a new record in TBL_transaction when clicking the button called button_keyIDs.

But I need to append one of the tags selected to each one of the lock/key ID records created in the TBL_transaction.

Below is my VBA for appending the selected list_keyIDs to TBL_transaction. If anyone has any ideas I will be very grateful.

Option Compare Database


Private Sub button_keyIDs_Click()

  Dim strSQL        As String

  Dim db            As DAO.Database

  Dim rs            As DAO.Recordset

  Dim ctl           As Control

  Dim varItem       As Variant


  On Error GoTo ErrorHandler


  Set db = CurrentDb()

  Set rs = db.OpenRecordset("TBL_transaction", dbOpenDynaset, dbAppendOnly)


'add selected value(s) to table

  Set ctl = Me.list_keyIDs

  For Each varItem In ctl.ItemsSelected

    rs.AddNew

    rs!trans_key_no = ctl.Column(1, varItem)

    rs!trans_lock_no = ctl.Column(0, varItem)

    rs.Update

  Next varItem

ExitHandler:

  Set rs = Nothing

  Set db = Nothing

  Exit Sub


ErrorHandler:

  Select Case Err

    Case Else

      MsgBox Err.Description

      DoCmd.Hourglass False

      Resume ExitHandler
  End Select


End Sub

 

[arnelgp]

Private Sub button_keyIDs_Click()

  Dim strSQL        As String

  Dim db            As DAO.Database

  Dim rs            As DAO.Recordset

  Dim ctl           As Control

  Dim varItem       As Variant

  Dim ctl2 As ListBox
  Dim varItem2 As Variant

  On Error GoTo ErrorHandler


  Set db = CurrentDb()

  Set rs = db.OpenRecordset("TBL_transaction", dbOpenDynaset, dbAppendOnly)


'add selected value(s) to table

  Set ctl = Me.list_keyIDs
  Set ctl2 = Me.listbox_tag_nos
 
  For Each varItem In ctl.ItemsSelected
    For Each varItem2 In ctl2.ItemsSelected

        rs.AddNew
    
        rs!trans_key_no = ctl.Column(1, varItem)
    
        rs!trans_lock_no = ctl.Column(0, varItem)
    
        rs("what field") = ctl2.ItemData(varItem2)
        rs.Update
        
    Next varItem2
  Next varItem

ExitHandler:

  Set rs = Nothing

  Set db = Nothing

  Exit Sub


ErrorHandler:

  Select Case Err

    Case Else

      MsgBox Err.Description

      DoCmd.Hourglass False

      Resume ExitHandler
  End Select


End Sub

 

[WithRegards]

thank you arnelgp! it is close ... but with the nested loop it is adding each item from list 2 to the item on list 1.

Eg. if there are 3 items selected in list 1, and 3 items selected in list 2, there are 9 rows appended to TBL_transaction instead of 3 in total

would you know how to fix that?

 

[arnelgp]

Option Compare Database

Option Compare Database


Private Sub button_keyIDs_Click()

  Dim strSQL        As String

  Dim db            As DAO.Database

  Dim rs            As DAO.Recordset

  Dim ctl           As Control

  Dim varItem       As Variant

  Dim ctl2 As ListBox
  Dim varItem2 As Variant
  Dim strTag As String
 
  On Error GoTo ErrorHandler


  Set db = CurrentDb()

  Set rs = db.OpenRecordset("TBL_transaction", dbOpenDynaset, dbAppendOnly)


'add selected value(s) to table

  Set ctl = Me.list_keyIDs
  Set ctl2 = Me.listbox_tag_nos
 
  For Each varItem In ctl.ItemsSelected
    
    If strTag = "" Then
        For Each varItem2 In ctl2.ItemsSelected
            
            strTag = strTag & ctl2.ItemData(varItem2) & ", "
            
        Next varItem2
    End If
    If strTag <> "" Then
        If Right(strTag, 2) = ", " Then
            strTag = Left(strTag, Len(strTag) - 2)
        End If
    End If
    rs.AddNew

    rs!trans_key_no = ctl.Column(1, varItem)

    rs!trans_lock_no = ctl.Column(0, varItem)

    rs("what field") = strTag
    rs.Update
 
  Next varItem

ExitHandler:

  Set rs = Nothing

  Set db = Nothing

  Exit Sub


ErrorHandler:

  Select Case Err

    Case Else

      MsgBox Err.Description

      
      DoCmd.Hourglass False

      Resume ExitHandler
  End Select


End Sub

 

[WithRegards]

thank you again arnelgp! it's so close... but it does something different again, see image below. Is it possible to have only one number in trans_tag_no for one trans_key_no?

 

[Gasman]

You have 6 keys and 7 tags?
How are you meant to reconcile which goes with which.?
Is it by their respective positions in the list?

 

[WithRegards]

You have 6 keys and 7 tags?
How are you meant to reconcile which goes with which.?
Is it by their respective positions in the list?

Hi Gasman. I meant to only select 6 in each list when taking the screenshot.

If there are 6 of each selected, it does not matter which tag goes with which key, as long as there is one tag per key.

 

[arnelgp]

Option Compare Database
Option Explicit

Option Compare Database

Option Compare Database


Private Sub button_keyIDs_Click()

  Dim strSQL        As String

  Dim db            As DAO.Database

  Dim rs            As DAO.Recordset

  Dim ctl           As Control

  Dim varItem       As Variant

  Dim ctl2 As ListBox
  Dim varItem2 As Variant
  Dim strTag As String
  Dim i As Integer
 
  On Error GoTo ErrorHandler


  Set db = CurrentDb()

  Set rs = db.OpenRecordset("TBL_transaction", dbOpenDynaset, dbAppendOnly)


'add selected value(s) to table

  Set ctl = Me.list_keyIDs
  Set ctl2 = Me.listbox_tag_nos
 
  For Each varItem In ctl.ItemsSelected
    
    strTag = ctl2.ItemsSelected(i)
    
    rs.AddNew

    rs!trans_key_no = ctl.Column(1, varItem)

    rs!trans_lock_no = ctl.Column(0, varItem)

    rs("what field") = strTag
    rs.Update
    
    i = i + 1
    If i > ctl2.ItemsSelected.count - 1 Then
        i = 0
    End If
 
  Next varItem

ExitHandler:

  Set rs = Nothing

  Set db = Nothing

  Exit Sub


ErrorHandler:

  Select Case Err

    Case Else

      MsgBox Err.Description

      
      DoCmd.Hourglass False

      Resume ExitHandler
  End Select


End Sub

 

[Gasman]

Hi Gasman. I meant to only select 6 in each list when taking the screenshot.

If there are 6 of each selected, it does not matter which tag goes with which key, as long as there is one tag per key.

OK, what is the need of selecting them.? Why not just put a tag from the same row as the key list?
What happens if we have x keys and only x-5 tags?

 

[WithRegards]

I got it to work! using a combination of arnelgp's code above and by matching the indexes of the items selected.

Thankyou arnelgp for your help!

Option Compare Database
Option Explicit


Private Sub button_keyIDs_Click()

  Dim strSQL        As String

  Dim db            As DAO.Database

  Dim rs            As DAO.Recordset

  Dim ctl           As Control

  Dim varItem       As Variant

  Dim ctl2 As ListBox
  Dim varItem2 As Variant
  Dim strTag As String
  Dim i As Integer
 
  On Error GoTo ErrorHandler


  Set db = CurrentDb()

  Set rs = db.OpenRecordset("TBL_transaction", dbOpenDynaset, dbAppendOnly)


'add selected value(s) to table

  Set ctl = Me.list_keyIDs
  Set ctl2 = Me.listbox_tag_nos
 
  For Each varItem In ctl.ItemsSelected
    
    For Each varItem2 In ctl2.ItemsSelected
    If varItem = varItem2 Then
        
    rs.AddNew

    rs!trans_key_no = ctl.Column(1, varItem)

    rs!trans_lock_no = ctl.Column(0, varItem)

    rs("trans_tag_no") = ctl2.Column(0, varItem2)
    rs.Update
        Else
        End If
    Next
    
    
 
  Next varItem

ExitHandler:

  Set rs = Nothing

  Set db = Nothing

  Exit Sub

 

[arnelgp]

glad you did it, you're the man!