Office Watch

Office 2013

Office Mobile / iPad

Office 2010

Office 2007

Office 2003

Office XP

Office for Mere Mortals

Access

Email

Buying Office

Office 365

Winks

Office News Wire

Join us!

Our Ebooks

Mobile | PDA

RSS


Search

Command Finder


Microsoft Office Bookshop

About

Home




Adding and Deleting Listbox Items, Part 2

View this page on the new Office-Watch.com web site - click here

by Access Watch

Bookmark and Share

  | Mobile | click for more article services     


View this page on the new Office-Watch.com web site - click here

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

View this page on the new Office-Watch.com web site - click here

there's more ...

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

Office 2013: the real startup guide

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

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.

More from Office Watch:



Article Services sponsored by: Office Watch Ebooks - available now to download and read today.
RSS feed for this category Subscribe

Translate | Mobile | Links
 Add to: Bookmarks | | DiggThis | Yahoo! My Web


New & Popular
» New Office-Watch.com web site
» Two ways for sorting by Number
» Office for iPad, September updates
» Why is Gene Cernan ignored in Word?
» DropBox prices drop but is it enough?
» Sort by hidden column in Word


Office Watch, Office for Mere Mortals, Access Watch and all titles used within the publications are Copyright © 1996-2014 Office Watch.
Microsoft Office, Microsoft Word, Microsoft Excel, Microsoft Outlook, Microsoft Powerpoint and doubtless many other names are registered trademarks of Microsoft Corporation.

Search  |  Sitemap |  Popular Topics | Privacy Statement |  Advertising |  Twitter |  Feedback / Contact Us
Office Watch is definitely not affiliated with Microsoft - and that's just one reason why we are so useful to Microsoft Office users around the world J (Erko).