MS Access 2007 VBA - Reusable list box code - ms-access

Question

I have a MS Access 2007 application which has several forms where I've used the same list box design. I have two list boxes, one of which gets values from a table with a query like:
SELECT id, value FROM table
And the second which is initially empty. In between these two list boxes are add and remove buttons, which are disabled by default. Clicking a value in the first list box enables the add button, and clicking a value in the second list box enables the remove button. Clicking the add button adds the selected item to the second list, and clicking the remove button removes an item for the second list.
The code I have for the add button is as follows ("ALLLIST" refers to the list with the query values, "SELECTEDLIST" is the one that's initially empty) :
Dim selectedId, selectedValue, safeValue As String
Dim existing As Boolean
Dim index As Integer
existing = False
selectedId = Me.ALLLIST.Value
index = Me.ALLLIST.ListIndex
selectedValue = Me.ALLLIST.Column(1,index)
'Loop through the list of selected values and see if this one has already been added to the list
For i = 0 To (Me.SELECTEDLIST.ListCount)
If (Me.SELECTEDLIST.Column(0, i) = selectedId) Then
existing = True
End If
Next i
'Only add the value if it's not already on the list
If (existing) Then
MsgBox "This list can't contain duplicate values", vbOKOnly + vbInformation, "Error"
Else
safeValue = Replace(selectedValue & "", "'", "''")
Me.SELECTEDLIST.AddItem (selectedId & ";'" & safeValue & "'")
Me.SELECTEDLIST.Value = Null
Me.REMOVEBUTTON.Enabled = False
End If
And the code for the remove button is:
Dim numItems, index As Integer
index = Me.SELECTEDLIST.ListIndex
'Remove the selected item and move to the top of the list
Me.SELECTEDLIST.RemoveItem (index)
Me.SELECTEDLIST.Selected(0) = True
numItems = Me.SELECTEDLIST.ListCount
'Cosmetic feature, select the row above the one we're removing
If (index > 0) Then
Me.SELECTEDLIST.Selected(index - 1) = True
Else
Me.SELECTEDLIST.Selected(0) = True
End If
'If the list is empty now, disable the remove button
If (numItems = 0) Then
Me.ALLLIST.SetFocus
Me.REMOVEBUTTON.Enabled = False
Me.SELECTEDLIST.Selected(-1) = True
End If
What I would like to do is, rather than copy and paste this code all over the place, have this template stored somewhere and then in my form code write something like:
hookUpLists(allListName, selectedListName, addButtonName, removeButtonName)
How can I do this? Can I write a module to do this some how? I'm also open to any improvements I can make on the above code.
Thanks

Answer 1

Thanks for the hint on using class modules, HK1, I'd never used them before.
To solve the original question, I created a new class module "MultiSelectListBox", which has the following code:
Option Compare Database
Private WithEvents allList As ListBox
Private WithEvents selectedList As ListBox
Private WithEvents addBtn As CommandButton
Private WithEvents removeBtn As CommandButton
Private numColumns As Integer
Public Sub hookUpLists(numberOfColumns As Integer, allValuesList As ListBox, selectedValuesList As ListBox, addButton As CommandButton, _
removeButton As CommandButton)
'Grab all the controls passed in
Set allList = allValuesList
Set selectedList = selectedValuesList
Set addBtn = addButton
Set removeBtn = removeButton
numColumns = numberOfColumns
'Tell Access we want to handle the click events for the controls here
allList.OnClick = "[Event Procedure]"
selectedList.OnClick = "[Event Procedure]"
addBtn.OnClick = "[Event Procedure]"
removeBtn.OnClick = "[Event Procedure]"
End Sub
Private Sub allList_Click()
addBtn.Enabled = True
End Sub
Private Sub selectedList_Click()
removeBtn.Enabled = True
End Sub
Private Sub addBtn_Click()
Dim selectedId As String
Dim existing As Boolean
Dim index As Integer
existing = False
selectedId = allList.Value
index = allList.ListIndex
'Loop through the list of selected values and see if this one has already been added to the list
For i = 0 To (selectedList.ListCount)
If (selectedList.Column(0, i) = selectedId) Then
existing = True
End If
Next i
'Only add the value if it's not already on the list
If (existing) Then
MsgBox "This list can't contain duplicate values", vbOKOnly + vbInformation, "Error"
Exit Sub
End If
Dim item As String
item = selectedId & ";"
'Loop over all of the columns and add them to the second list box
For i = 1 To numColumns - 1
item = item & "'" & Replace(allList.Column(i, index) & "", "'", "''") & "'"
'Don't add a trailing semicolon
If (i <> numColumns - 1) Then
item = item & ";"
End If
Next i
selectedList.AddItem (item)
selectedList.Value = Null
removeBtn.Enabled = False
'Select the next row
If (index <> allList.ListCount - 1) Then
allList.Selected(index + 1) = True
allList.Value = allList.Column(0, index + 1)
End If
End Sub
Private Sub removeBtn_Click()
Dim numItems, index As Integer
index = selectedList.ListIndex
'Remove the selected item and move to the top of the list
selectedList.RemoveItem (index)
selectedList.Selected(0) = True
numItems = selectedList.ListCount
'Cosmetic feature, select the row above the one we're removing
If (index > 0) Then
selectedList.Selected(index - 1) = True
Else
selectedList.Selected(0) = True
End If
'If the list is empty now, disable the remove button
If (numItems = 0) Then
allList.SetFocus
removeBtn.Enabled = False
selectedList.Selected(-1) = True
End If
End Sub
Most of the above is identical to what I was already using, one important thing to note for anyone stumbling across this is the use of "WithEvents" when declaring the variables. This tells Access to look in the class module for event handlers. Finally, from my form I can do the following:
Private contactList As MultiSelectListBox
Private Sub Form_Open(Cancel As Integer)
Set contactList = New MultiSelectListBox
contactList.hookUpLists 3, Me.allContactsList, Me.selectedContactsList, Me.addContactBtn, Me.removeContactBtn
End Sub