web 2.0


Access 2007 move items between listboxes, filter listbox and clear listbox Items

Have you ever wondered how to move items between listboxes in Microsoft Access using VBA? How about filtering listbox items as you type?

 

Using VBA in Microsoft Access, the objectives of this article are (Watch the following YouTube movie to see it in action http://www.youtube.com/watch?v=n0ykubD6e8g or check the bottom part of the article) :

 

·         Clear a listbox in Microsoft Access

·         Move items between  two listboxes in Microsoft Access

·         Filter listbox as you type

·         Move listbox items with double click

 

Before you continue, you will need the following setup:

 

·         Add VBA reference to Microsoft ActiveX Objects X.x (Where X.x is the version registered in your machine)

·         Add a table (name it tblNames) with the following fields:

o   IDName

o   FullName

o   ShowYesNoFilter (set the default value to “Yes”)

·         Create two queries and name them as follows

o   tblNames QueryNo (set the filter criteria to “No” and order ascending)

o   tblNames QueryYes(set the filter criteria to “Yes” and order ascending)

·         Create a form and the following controls

o   Textbox (name it “txtFilter”)

o   Listbox 1

§  Name it “ListNoItems”

§  Set its Row Source to tblNames QueryNo

§  Set its Row Source type to Table/Query

o   Listbox 2

§  Name it “ListYesItems”

§  Set its Row Source to tblNames QueryYes

§  Set its Row Source type to Table/Query

o   Button 1

§  Name it “cmdAddOne”

§  Caption: >

o   Button 2

§  Name it “cmdAddAll”

§  Caption: >>

o   Button 3

§  Name: “cmdRemoveOne”

§  Caption: <

o   Button 4

§  Name: “cmdRemoveAll”

§  Caption: <<

 

Once you have done that, your setup will look like this:



Now, you can add the code as follows:

Option Compare Database
Option Explicit

'*********************************************************************************************************************
'CONSTANTS
Private Const mstr_MsgBoxTitle                  As String = "Meu projeto Access 2007"
Private Const mstr_MsgNoItemToMove              As String = "Não há item para mover ou item não foi selecionado..."
Private Const mstr_Yes                          As String = "Yes"
Private Const mstr_No                           As String = "No"
Private Const mstr_Filtered                     As String = "Filtered"

'*********************************************************************************************************************
'STRINGS
Private mstr_SQLInstruction                     As String

'*********************************************************************************************************************
'OBJECTS
Private mobj_ADODBRecordset                     As ADODB.Recordset

Sub ExecuteCommand(ByVal strExecuteSQL, ByVal strShowYesNoFilter As String)
   
    Set mobj_ADODBRecordset = New ADODB.Recordset
   
    With mobj_ADODBRecordset
        .Open strExecuteSQL, CurrentProject.Connection, adOpenKeyset, adLockOptimistic
        If Not .BOF Then .MoveFirst
       
        Do While Not .EOF
            .Fields("ShowYesNoFilter").Value = strShowYesNoFilter
            .Update
            .MoveNext
        Loop
    End With
       
    Me.ListYesItems.Requery
    Me.ListNoItems.Requery
   
    mstr_SQLInstruction = ""
    Set mobj_ADODBRecordset = Nothing


End Sub


Private Sub cmdAddAll_Click()
    mstr_SQLInstruction = "SELECT tblNames.IDName, tblNames.FullName, tblNames.ShowYesNoFilter, "
    mstr_SQLInstruction = mstr_SQLInstruction & "tblNames.ShowYesNoFilter FROM tblNames "
    mstr_SQLInstruction = mstr_SQLInstruction & "WHERE (((tblNames.ShowYesNoFilter)='" & mstr_Yes & "'));"

    ExecuteCommand mstr_SQLInstruction, "No"
   
End Sub

Private Sub cmdAddOne_Click()
    Dim strSelectedItem                 As String
    Dim lngSelectedItemIndex            As Long
   
    On Error Resume Next
    If Me.ListYesItems.ListIndex = -1 Then
        MsgBox mstr_MsgNoItemToMove, vbInformation, mstr_MsgBoxTitle
        Exit Sub
    End If
   
    lngSelectedItemIndex = Me.ListYesItems.ListIndex
    strSelectedItem = Me.ListYesItems.ItemData(lngSelectedItemIndex)

    If Len(Me.ListYesItems.ItemData(lngSelectedItemIndex)) < 1 Then
        MsgBox mstr_MsgNoItemToMove, vbInformation, mstr_MsgBoxTitle
        Exit Sub
    End If
   
   
    mstr_SQLInstruction = "SELECT tblNames.IDName, tblNames.FullName, tblNames.ShowYesNoFilter, "
    mstr_SQLInstruction = mstr_SQLInstruction & "tblNames.ShowYesNoFilter FROM tblNames "
    mstr_SQLInstruction = mstr_SQLInstruction & "WHERE (((tblNames.FullName)='" & strSelectedItem & "'));"

    ExecuteCommand mstr_SQLInstruction, mstr_No

End Sub

Private Sub cmdRemoveAll_Click()
    mstr_SQLInstruction = "SELECT tblNames.IDName, tblNames.FullName, tblNames.ShowYesNoFilter, "
    mstr_SQLInstruction = mstr_SQLInstruction & "tblNames.ShowYesNoFilter FROM tblNames "
    mstr_SQLInstruction = mstr_SQLInstruction & "WHERE (((tblNames.ShowYesNoFilter)='" & mstr_No & "'));"

    ExecuteCommand mstr_SQLInstruction, mstr_Yes

End Sub

Private Sub cmdRemoveOne_Click()
    Dim strSelectedItem                 As String
    Dim lngSelectedItemIndex            As Long
   
    'On Error Resume Next
   
    If Me.ListNoItems.ListIndex = -1 Then
        MsgBox mstr_MsgNoItemToMove, vbInformation, mstr_MsgBoxTitle
        Exit Sub
    End If
   
    lngSelectedItemIndex = Me.ListNoItems.ListIndex
    strSelectedItem = Me.ListNoItems.ItemData(lngSelectedItemIndex)

    If Len(Me.ListNoItems.ItemData(lngSelectedItemIndex)) < 1 Then
        MsgBox mstr_MsgNoItemToMove, vbInformation, mstr_MsgBoxTitle
        Exit Sub
    End If
   
    mstr_SQLInstruction = "SELECT tblNames.IDName, tblNames.FullName, tblNames.ShowYesNoFilter, "
    mstr_SQLInstruction = mstr_SQLInstruction & "tblNames.ShowYesNoFilter FROM tblNames "
    mstr_SQLInstruction = mstr_SQLInstruction & "WHERE (((tblNames.FullName)='" & strSelectedItem & "'));"

    ExecuteCommand mstr_SQLInstruction, mstr_Yes
End Sub

Private Sub Form_Open(Cancel As Integer)
   
    mstr_SQLInstruction = "SELECT tblNames.IDName, tblNames.FullName, tblNames.ShowYesNoFilter, "
    mstr_SQLInstruction = mstr_SQLInstruction & "tblNames.ShowYesNoFilter FROM tblNames "
    mstr_SQLInstruction = mstr_SQLInstruction & "WHERE (((tblNames.ShowYesNoFilter)='" & mstr_No & "')) "
    mstr_SQLInstruction = mstr_SQLInstruction & "OR (((tblNames.ShowYesNoFilter)='" & mstr_Filtered & "'));"
   
    ExecuteCommand mstr_SQLInstruction, mstr_Yes
   
End Sub

Private Sub ListNoItems_DblClick(Cancel As Integer)
    cmdRemoveOne_Click
End Sub

Private Sub ListYesItems_DblClick(Cancel As Integer)
    cmdAddOne_Click
End Sub

Private Sub txtFilter_KeyUp(KeyCode As Integer, Shift As Integer)
    Dim strFilter                   As String

    strFilter = Me.txtFilter.Text
   
    Select Case KeyCode
        Case 8, 46

            mstr_SQLInstruction = "SELECT tblNames.FullName, tblNames.ShowYesNoFilter FROM tblNames "
            mstr_SQLInstruction = mstr_SQLInstruction & "WHERE (((tblNames.FullName) Not Like '%" & strFilter & "%') "
            mstr_SQLInstruction = mstr_SQLInstruction & "Or ((tblNames.ShowYesNoFilter) = '" & mstr_Filtered & "'));"
           
            ExecuteCommand mstr_SQLInstruction, mstr_Yes


            mstr_SQLInstruction = "SELECT tblNames.FullName, tblNames.ShowYesNoFilter FROM tblNames "
            mstr_SQLInstruction = mstr_SQLInstruction & "WHERE (((tblNames.FullName) Not Like '%" & strFilter & "%') "
            mstr_SQLInstruction = mstr_SQLInstruction & "And ((tblNames.ShowYesNoFilter) = '" & mstr_Yes & "'));"

            ExecuteCommand mstr_SQLInstruction, mstr_Filtered
       
        Case Else
            mstr_SQLInstruction = "SELECT tblNames.FullName, tblNames.ShowYesNoFilter FROM tblNames "
            mstr_SQLInstruction = mstr_SQLInstruction & "WHERE (((tblNames.FullName) Not Like '%" & strFilter & "%') "
            mstr_SQLInstruction = mstr_SQLInstruction & "And ((tblNames.ShowYesNoFilter) = '" & mstr_Yes & "'));"
           
            ExecuteCommand mstr_SQLInstruction, mstr_Filtered
    End Select
   
End Sub

 

 

Tags: , , , ,

Microsoft Access | Microsoft Access - VBA

Comments

travel coffee mugs People's Republic of China, on 3/7/2010 5:51:02 PM Said:

travel coffee mugs

Seems like you have put lots of hard work into your article and I need much more of these on the internet currently. I sincerely got a kick out of your post. I don't definitely have significantly to talk about responding, I only wished to comment to reply great work.

Denyse Fontanilla United States, on 3/8/2010 8:35:00 AM Said:

Denyse Fontanilla

great post, are you a professional writer?

abdhaneef.wordpress.com , on 6/26/2011 12:20:38 PM Said:

pingback

Pingback from abdhaneef.wordpress.com

Access 2007 move items between listboxes, filter listbox and clear listbox Items | abdhaneef

dbforums.com , on 8/2/2011 4:36:33 PM Said:

pingback

Pingback from dbforums.com

User-Defined Error...Need Help! - dBforums

adminscode.com , on 8/2/2011 5:12:33 PM Said:

pingback

Pingback from adminscode.com

User-Defined Error…Need Help! | Coders & Admins

accessforums.net , on 7/22/2013 12:27:02 AM Said:

pingback

Pingback from accessforums.net

remove multiple selected items from listbox

Comments are closed