Adding and Deleting Listbox Items, Part 2

by Access Watch

| Mobile | click for more article services

Access Archon #172

Using the AddItem and RemoveItem Methods

The frmPairedListboxesMethodsUnsorted form uses the new AddItem and RemoveItem methods to move items from one listbox to the other. You can't simply iterate through the ItemsSelected collection of the listbox, and use the appropriate method, since using AddItem or RemoveItem clears the selections, so I fill an array with values from the selected items, and use the array for adding or removing list items.

There is another issue with these methods: unlike the tables method, when you use the AddItem and RemoveItem methods to work with listbox items, the list loses its alphabetization, as the newly added item always goes to the bottom of the list, as shown in Figure C:

Figure C. A form with unalphabetized list items

VBA Code

The AddItem/RemoveItem code is much simpler:

Private Sub cmdAdd_Click()

On Error GoTo ErrorHandler

Set lstSelected = Me![lstSelectedItems]

Set lstAvailable = Me![lstAvailableItems]

'Check that at least one item has been selected

If lstAvailable.ItemsSelected.Count = 0 Then

MsgBox "Please select at least one item"

lstAvailable.SetFocus

GoTo ErrorHandlerExit

End If

'Add selected items to an array, since removing an item

'from the list with RemoveItem clears the selections

intItem = 0

lngCount = lstAvailable.ItemsSelected.Count

ReDim ListItems(lngCount - 1)

For Each varItem In lstAvailable.ItemsSelected

ListItems(intItem) = Nz(lstAvailable.Column(0, varItem))

intItem = intItem + 1

Next varItem

For i = 0 To lngCount - 1

strItem = ListItems(i)

'Append selected item to Selected Items value list

lstSelected.AddItem strItem

'Delete selected item from Available Items value list

lstAvailable.RemoveItem strItem

Next i

ErrorHandlerExit:

Exit Sub

ErrorHandler:

MsgBox "Error No: " & Err.Number & "; Description: " & Err.Description

Resume ErrorHandlerExit

End Sub

Private Sub cmdRemove_Click()

On Error GoTo ErrorHandler

Set lstSelected = Me![lstSelectedItems]

Set lstAvailable = Me![lstAvailableItems]

'Check that at least one item has been selected

If lstSelected.ItemsSelected.Count = 0 Then

MsgBox "Please select at least one item"

lstSelected.SetFocus

GoTo ErrorHandlerExit

End If

'Add selected items to an array, since removing an item

'from the list with RemoveItem clears the selections

intItem = 0

lngCount = lstSelected.ItemsSelected.Count

ReDim ListItems(lngCount - 1)

For Each varItem In lstSelected.ItemsSelected

ListItems(intItem) = Nz(lstSelected.Column(0, varItem))

intItem = intItem + 1

Next varItem

For i = 0 To lngCount - 1

strItem = ListItems(i)

'Append selected item to Selected Items value list

lstAvailable.AddItem strItem

'Delete selected item from Available Items value list

lstSelected.RemoveItem strItem

Next i

ErrorHandlerExit:

Exit Sub

ErrorHandler:

MsgBox "Error No: " & Err.Number & "; Description: " & Err.Description

Resume ErrorHandlerExit

End Sub

Private Sub Form_Load()

On Error GoTo ErrorHandler

DoCmd.RunCommand acCmdSizeToFitForm

Me![lstAvailableItems].RowSource = _

"Beverages;Condiments;Confections;DairyProducts;" _

& "Grains/Cereals;Meat/Poultry;Produce;Seafood"

Me![lstSelectedItems].RowSource = ""

ErrorHandlerExit:

Exit Sub

ErrorHandler:

MsgBox "Error No: " & Err.Number & "; Description: " & Err.Description

Resume ErrorHandlerExit

End Sub

However, after some experimentation, I was able to restore alphabetization by saving arrays from the listboxes (after adding or deleting items), sorting the arrays using the WordBasic.SortArray method, and then writing the sorted arrays back to the listboxes. Figure D shows listboxes on the frmPairedListboxesMethodsSorted form with their lists sorted alphabetically, after adding and deleting list items using the AddItem and RemoveItem methods:

Figure D. A form with alphabetized lists after using the AddItem and RemoveItem methods

VBA Code

The cmdAdd_Click procedure is listed below; the cmdRemove procedure is similar, just switching Available and Selected.

Private Sub cmdAdd_Click()

'Word reference is needed in order to use WordBasic.SortArray

On Error GoTo ErrorHandler

Set lstSelected = Me![lstSelectedItems]

Set lstAvailable = Me![lstAvailableItems]

Set pappWord = GetObject(, "Word.Application")

'Check that at least one item has been selected

If lstAvailable.ItemsSelected.Count = 0 Then

MsgBox "Please select at least one item"

lstAvailable.SetFocus

GoTo ErrorHandlerExit

End If

'Add selected items to an array, since removing an item

'from the list with RemoveItem clears the selections

intItem = 0

lngCount = lstAvailable.ItemsSelected.Count - 1

Debug.Print "List count: " & lngCount

ReDim ListItemsAvailable(lngCount)

For Each varItem In lstAvailable.ItemsSelected

ListItemsAvailable(intItem) = Nz(lstAvailable.Column(0, varItem))

intItem = intItem + 1

Next varItem

'Using the array, add and remove items from lists

For i = 0 To lngCount

strItem = ListItemsAvailable(i)

Debug.Print "List item: " & strItem

'Append selected item to Selected Items value list

lstSelected.AddItem strItem

'Delete selected item from Available Items value list

lstAvailable.RemoveItem strItem

Next i

'At this point the lists may have lost their alphabetization,

'so recreate arrays from the lists, sort the arrays, and

'recreate the lists

intRows = lstAvailable.ListCount - 1

Debug.Print "List rows: "; intRows

If intRows < 0 Then

GoTo Selected

End If

ReDim ListItemsAvailable(intRows)

For intIndex = 0 To intRows

ListItemsAvailable(intIndex) = _

lstAvailable.Column(Index:=0, Row:=intIndex)

Next intIndex

'Sort the array

pappWord.WordBasic.SortArray ListItemsAvailable

'Clear the value list and recreate it from the sorted array

lstAvailable.RowSource = ""

lngCount = UBound(ListItemsAvailable)

For i = 0 To lngCount

strItem = ListItemsAvailable(i)

'Append selected item to Available Items value list

lstAvailable.AddItem strItem

Next i

Selected:

intRows = lstSelected.ListCount - 1

If intRows < 0 Then

GoTo ErrorHandlerExit

End If

ReDim ListItemsSelected(intRows)

For intIndex = 0 To intRows

ListItemsSelected(intIndex) = _

lstSelected.Column(Index:=0, Row:=intIndex)

Next intIndex

'Sort the array

pappWord.WordBasic.SortArray ListItemsSelected

'Clear the value list and recreate it from the sorted array

lstSelected.RowSource = ""

lngCount = UBound(ListItemsSelected)

For i = 0 To lngCount

strItem = ListItemsSelected(i)

'Append selected item to Selected Items value list

lstSelected.AddItem strItem

Next i

'Clear listbox selections

intRows = lstAvailable.ListCount - 1

For intIndex = 0 To intRows

lstAvailable.Selected(intIndex) = False

Next intIndex

intRows = lstSelected.ListCount - 1

For intIndex = 0 To intRows

lstSelected.Selected(intIndex) = False

Next intIndex

ErrorHandlerExit:

Set pappWord = Nothing

Exit Sub

ErrorHandler:

If Err = 429 Then

'Word is not running; open Word with CreateObject

Set pappWord = CreateObject("Word.Application")

Resume Next

Else

MsgBox "Error No: " & Err.Number & "; Description: " _

& Err.Description

Resume ErrorHandlerExit

End If

End Sub

References

The code in the sample database needs the following references (in addition to the default references):

Microsoft DAO 3.6 Object Library

Microsoft Word 11.0 Object Library

If you import code or objects into a database of your own, you may need to set one or more of these references. The version number may differ, depending on your Office version; check the version you have. References are set in the References dialog, opened from the VBA window. For more information on working with references, see Access Archon #107, Working with References.

Supporting Files

The zip file containing this article, in Word 97-2003 format, plus the supporting file(s), may be downloaded from the Access Archon page of my Web site, as accarch172.zip, which is the last entry in the table of Access Archon columns for Access Watch.

Document Name	Document Type	Place in
Listbox Items (AA 172).mdb	Access 2002-2003 database (can also be used in higher versions of Access)	Wherever you want

Article posted: Thursday, 11 September 2008

there's more ...

If you liked this article you'll LOVE our new ebooks.

OFFICE 2013: the real startup guide Everything you need to know about Office 2013 but Microsoft won't tell you.

How to save money, install, configure and use the new features in Office 2013. Get it today - click here.

Windows 8 for Microsoft Office users A practical guide the new, changed and unfamiliar in Windows 8

A focused and unvarnished look at Windows 8, especially written for the many people who use Microsoft Office Get it today - click here.

ORGANIZING OUTLOOK EMAIL - tame your Outlook 2010 Inbox

100+ pages of practical tips and help to streamline, automate and search your Inbox. Get more than you ever thought possible from Outlook. Read it today - click here.