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

 

 

In a video (http://www.youtube.com/watch?v=bGjqDGF7xaM) published on YouTube back in 2008, I explained how to highlight the active row in Excel. In this brief article, I discuss how you can highlight the active cell in Excel. In this particular case, I will only change the font color of the cell, but you can later change the conditional formatting and apply whatever formatting you wish.

Here's how it is done:

1. Create a named range called AddressOfActiveCell using the formula: =ADDRESS(5,6)
2. Select the entire worksheet and apply a conditional formatting using the formula (the active cell being A1 upon selection): =ADDRESS(ROW(A1),COLUMN(A1))=AddressOfActiveCell
3. Now, open the visual basic editor and insert the following code:


Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)

    With ThisWorkbook.Names("AddressOfActiveCell")
        .Name = "AddressOfActiveCell"
        .RefersToR1C1 = "=address(" & ActiveCell.Row & "," & ActiveCell.Column & ")"
    End With

End Sub

Check the video tutorial here:

This is a follow up to my post on sending email messages using Windows Vista. You can read the previous post here: http://www.msofficegurus.com/post/How-to-Windows-Vista-SMTP-Server-Using-CDOMessage.aspx

In this post, I discuss email validation using VBA. VBA email validation is a very simple process that does not require much, but you will need to install the Microsoft VBScript Regular Expressions 5.5.

In order to install the reference, follow these steps:

1. Open VBE (Alt+F11)
2. Go to “Tools --> References…”
3. Search in the reference list for Microsoft VBScript Regular Expressions 5.5, select it and click OK to continue.

The figure below shows the reference installed:


Figure 1: Microsoft VBScript Regular Expressions 5.5 reference installed

NOTE:
Only today, after receiving a comment on this post, I noticed that I was using Excel in Portuguese and not English. Since I am always changing the language settings, I sometimes forget to change back to the language I am writing on. I will leave the image as it is, as I am sure everyone can get the picture (if you will forgive me the pun). Added: July 3rd, 2009

Now, you can create a boolean user-defined function to test an email string to check whether it is a “regular expression”. In my case, I check for the following pattern:

\w+([-+.']\w+)*@\w+([-.]\w+)*\.\w+([-.]\w+)*

There are a number of patterns that you can you and you should be able to find my patterns, especially in sites that teach java or php (check RFC 2822 for info on pattern). You can then borrow one of those patterns and use in your code.

The user-defined function will look like this:

Function ValidateEmail(ByVal sEmail As String) As Boolean
 
    Dim oRegularExpression     As RegExp
 
'   Sets the regular expression object
    Set oRegularExpression = New RegExp

    With oRegularExpression
'   Sets the regular expression pattern
        .Pattern = "\w+([-+.']\w+)*@\w+([-.]\w+)*\.\w+([-.]\w+)*"
 
'   Ignores case
        .IgnoreCase = True

'       Test email string
        ValidateEmail = .Test(sEmail)
    End With
   
End Function

You can now test the user-defined function with a simple call:

Sub Test_ValidateEmail()
    MsgBox ValidateEmail("my.email@hotmail.com")
    MsgBox ValidateEmail("your.EMAIL@hotmail,com")
End Sub

A few days ago, I was writing an article and someone asked me: how the heck do I use the classic AutoFormat for my Excel 2007 PivotTable?

The image below shows xlReport4 AutoFormat (the data is not in English, as the original article was not in English – but I am sure you get the picture):


Figure 1: Excel 2007 PivotTable Classic AutoFormat

Well, an alternative to this is to use VBA. The following code would suffice:

Sub Test()
    ActiveSheet.PivotTables("PivotTable1").Format xlReport6
End Sub

In this case, I use xlReport6 instead of xlReport4. However, this approach may not be acceptable to all users, after all, not everyone is fluent with VBA. You could, of course, create a simple customization to apply this classic PivotTable format, but what about the other AutoFormat which are available?

Well, there is a simpler way to achieve that. Simply use the accelerator key combination. Follow these steps:

1. Select the Excel 2007 PivotTable
2. Type the key sequence: Alt à o à a. Notice that this sequence will vary according to the language. This sequence is for English. The sequence in Portuguese (BR), the language I was writing the original article, is Alt à f à a.

The Excel 2003 AutoFormat dialog box will open:

Figure 2: Excel 2003 Classic AutoFormat dialog box

Simply choose the AutoFormat you want and click OK. You’re set to go.