OfficeTalk: Working with Lists and Tables: VBA Samples (Part 2 of 2)

Article
05/23/2014

This content is no longer actively maintained. It is provided as is, for anyone who may still be using these technologies, with no warranties or claims of accuracy with regard to the most recent product version or service release.

Summary: Tables and lists are an integral part of Microsoft Excel. Microsoft Excel MVP Ron de Bruin explains some handy VBA subroutines that can make you more productive when using tables or lists. (8 printed pages)

Ron de Bruin, Excel MVP

Frank Rice, Microsoft Corporation

May 2009

Applies to: Microsoft Office Excel 2003, Microsoft Office Excel 2007

Contents

Copying Tables or Lists to New Workbooks
Filtering Tables or Lists
Clearing Filters
Conclusion
Additional Resources

To download a Microsoft Excel workbook containing the procedures discussed in these column and more, see VBA Code Examples for Tables in Excel 2007 or a List in Excel 2003.

Copying Tables or Lists to New Workbooks

The following code is similar to the subroutine in the previous column except that instead of copying the table or list to a new worksheet in the same workbook, the procedure copies the visible data to a new workbook.

Sub CopyListOrTableData2NewWorkbook()
'Works in Excel 2003 and Excel 2007. Only copies visible data.
    Dim New_Ws As Worksheet
    Dim ACell As Range
    Dim CCount As Long
    Dim ActiveCellInTable As Boolean
    Dim CopyFormats As Variant

    'Check to see if the worksheet is protected.
    If ActiveSheet.ProtectContents = True Then
        MsgBox "This macro will not work when the worksheet is write-protected."
        Exit Sub
    End If

    'Set a reference to the ActiveCell named ACell. You can always use
    'ACell now to point to this cell, no matter where you are in the workbook.
    Set ACell = ActiveCell

    'Test to see if ACell is in a table or list. Note that by using ACell.ListObject, you
    'don't need to know the name of the table to work with it.
    On Error Resume Next
    ActiveCellInTable = (ACell.ListObject.Name <> "")
    On Error GoTo 0

    'If the cell is in a list or table, run the code.
    If ActiveCellInTable = True Then

        With Application
            .ScreenUpdating = False
            .EnableEvents = False
        End With

        On Error Resume Next
        With ACell.ListObject.ListColumns(1).Range
            CCount = .SpecialCells(xlCellTypeVisible).Areas(1).Cells.Count
        End With
        On Error GoTo 0

        'Test if there are more than 8192 separate areas. Excel only supports
        'a maximum of 8,192 non-contiguous areas through VBA macros and manual.
        If CCount = 0 Then
            MsgBox "There are more than 8192 areas, so it is not possible to " & _
                   "copy the visible data to a new workbook. Tip: Sort your " & _
                   "data before you apply the filter and try this macro again.", _
                   vbOKOnly, "Copy to new workbook"
        Else
            'Copy the visible cells to the new workbook.
            ACell.ListObject.Range.Copy

            'Add a new workbook with one worksheet.
            Set New_Ws = Workbooks.Add(xlWBATWorksheet).Worksheets(1)

            'Paste the data in the worksheet into the new workbook.
            On Error Resume Next
            With New_Ws.Range("A1")
                .PasteSpecial xlPasteColumnWidths
                .PasteSpecial xlPasteValuesAndNumberFormats
                .Select
                Application.CutCopyMode = False
            End With
            On Error GoTo 0

            'Call the Create List or Table dialog
            Application.ScreenUpdating = True
            Application.CommandBars.FindControl(ID:=7193).Execute
            New_Ws.Range("A1").Select

            ActiveCellInTable = False
            On Error Resume Next
            ActiveCellInTable = (New_Ws.Range("A1").ListObject.Name <> "")
            On Error GoTo 0
            Application.ScreenUpdating = False

            'If you do not create a table, you have an option to copy the formats.
            If ActiveCellInTable = False Then
                Application.GoTo ACell
                CopyFormats = MsgBox("Do you also want to copy the Formats?", _
                                     vbOKCancel + vbExclamation, "Copy to new workbook")
                If CopyFormats = vbOK Then
                    ACell.ListObject.Range.Copy
                    With New_Ws.Range("A1")
                        .PasteSpecial xlPasteFormats
                        Application.CutCopyMode = False
                    End With
                End If
            End If

        End If

        'Select the new workbook if it is not active.
        Application.GoTo New_Ws.Range("A1")

        With Application
            .ScreenUpdating = True
            .EnableEvents = True
        End With

    Else
        MsgBox "Select a cell in your list or table before you run the macro.", _
               vbOKOnly, "Copy to new workbook"
    End If
End Sub

Filtering Tables or Lists

The following code filters a table or list. To test the procedure, I used a table similar to Figure 1. Just type in the data and then use the procedure described at the beginning of this column to encapsulate it into a table.

Figure 1. A sample table for testing the filter macro

Sub FilterListOrTableData()
'Works in Excel 2003 and Excel 2007.
    Dim ACell As Range
    Dim ActiveCellInTable As Boolean
    Dim FilterCriteria As String

    'Check to see if the worksheet is protected.
    If ActiveSheet.ProtectContents = True Then
        MsgBox "This macro will not work when the worksheet is write-protected.", _
               vbOKOnly, "Filter example"
        Exit Sub
    End If

    'Set a reference to the ActiveCell named ACell. You can always use
    'ACell now to point to this cell, no matter where you are in the workbook.
    Set ACell = ActiveCell

    'Test to see if ACell is in a table or list. Note that by using ACell.ListObject, you
    'don't need to know the name of the table to work with it.
    On Error Resume Next
    ActiveCellInTable = (ACell.ListObject.Name <> "")
    On Error GoTo 0

    'If the cell is in a list or table, run the code.
    If ActiveCellInTable = True Then
        'Show all data in the table or list.
        On Error Resume Next
        ActiveSheet.ShowAllData
        On Error GoTo 0

        'This example filters on the first column in the List/Table
        '(change the field if needed). In this case the Table starts
        'in A so Field:=1 is column A, field 2 = column B, ......
        'Use "<>" & filtercriteria if you want to exclude the criteria from the filter.
        FilterCriteria = InputBox("What text do you want to filter on?", _
                                  "Type in the filter item.")
        ACell.ListObject.Range.AutoFilter _
                Field:=1, _
                Criteria1:="=" & FilterCriteria
    Else
        MsgBox "Select a cell in your list or table before you run the macro.", _
               vbOKOnly, "Filter example"
    End If
End Sub

If you want to filter on the active cell instead, change the following lines:

FilterCriteria = InputBox("What text do you want to filter on?", _
    "Type in the filter item.")
ACell.ListObject.Range.AutoFilter _
    Field:=1, _
    Criteria1:="=" & FilterCriteria

To the following:

'This example filters on the ActiveCell value.
ACell.ListObject.Range.AutoFilter _
    Field:=ACell.Column - ACell.ListObject.Range.Cells(1).Column + 1, _
    Criteria1:="=" & ACell.Text

Likewise, if you want to use the text in cell C1 as the filter criteria, replace the following lines:

FilterCriteria = InputBox("What text do you want to filter on?", _
    "Type in the filter item.")
ACell.ListObject.Range.AutoFilter _
    Field:=1, _
    Criteria1:="=" & FilterCriteria

To the following:

'This example filters on the first column in the List/Table.
'(change the field if needed). In this case the Table starts
'in column A so Field:=1 is column A, field 2 = column B, 
'It will use a cell text of Range("C1")for the Criteria.
ACell.ListObject.Range.AutoFilter _
    Field:=1, _
    Criteria1:="=" & Range("C1").Text

If you want to add your criteria in the code, replace the following lines:

FilterCriteria = InputBox("What text do you want to filter on?", _
    "Type in the filter item.")
ACell.ListObject.Range.AutoFilter _
    Field:=1, _
    Criteria1:="=" & FilterCriteria

To the following:

'This example filters on the first column in the List/Table
'(change the field if needed). In this case the Table starts
'in A so Field:=1 is column A, 2 = column B, ......
'Use "<>Netherlands" if you want to exclude the criteria from the filter
ACell.ListObject.Range.AutoFilter Field:=1, Criteria1:="=Netherlands"

You can also use this to filter for all Sales Representatives born between 23 Feb 1947 and 7 May 1988 from the Netherlands and the USA (column A, C and D in the sample table). Use two criteria in field 1 and 4 (2 items are the maximum number of criteria for AutoFilter).

ACell.ListObject.Range.AutoFilter Field:=1, Criteria1:="=Netherlands", Operator:=xlOr, Criteria2:="=USA"
ACell.ListObject.Range.AutoFilter Field:=3, Criteria1:="=Sales Representative"
ACell.ListObject.Range.AutoFilter Field:=4, Criteria1:=">=02/23/1947" , _
    Operator:=xlAnd, Criteria2:="<=05/07/1988"

Important

When using VBA code, you must use the United States’s date format mm/dd/yyyy to filter dates. In the user interface, you can use any date format. For more information, see International Issues.

Tip

If you want to filter every record that has a value in the first column that starts with Netherlands, you can use Criteria1:="=Netherlands*". If Netherlands is a part of the string, you can use Criteria1:="=Netherlands". You can also use the ? as a wildcard for one character . If the is part of the name you are filtering on as in USA, you can use USA~ where the ~ is a substitute for the single character . You can also use ~? or~ ~ if ? or ~ are part of the string.

Clearing Filters

The following macro clears a filter on a table or list.

Sub ClearFilterListOrTable()
'Works in Excel 2003 and Excel 2007.
    Dim ACell As Range
    Dim ActiveCellInTable As Boolean

    'Check to see if the worksheet is protected.
    If ActiveSheet.ProtectContents = True Then
        MsgBox "This macro will not work when the worksheet is write-protected.", _
               vbOKOnly, "Clear filter example"
        Exit Sub
    End If

    'Set a reference to the ActiveCell named ACell. You can always use
    'ACell now to point to this cell, no matter where you are in the workbook.
    Set ACell = ActiveCell

    'Test to see if ACell is in a table or list. Note that by using ACell.ListObject, you
    'don't need to know the name of the table to work with it.
    On Error Resume Next
    ActiveCellInTable = (ACell.ListObject.Name <> "")
    On Error GoTo 0

    'If the cell is in a list or table, run the code.
    If ActiveCellInTable = True Then
        'Show all data in the table or list.
        On Error Resume Next
        ActiveSheet.ShowAllData
        On Error GoTo 0
    Else
        MsgBox "Select a cell in your list or table before you run the macro.", _
               vbOKOnly, "Clear filter example"
    End If
End Sub

Conclusion

The methods showcased in this column and in OfficeTalk: Working with Lists and Tables: VBA Samples (Part 1 of 2) provide a starting place for you to explore the other VBA objects and methods available to help you work with lists and tables.

Additional Resources

More information on the subjects described in this column can be found at the following locations.

OfficeTalk: Working with Lists and Tables: VBA Samples (Part 2 of 2)

Copying Tables or Lists to New Workbooks

Filtering Tables or Lists

Clearing Filters

Conclusion

Additional Resources

Additional resources