Filtering by the Active Cell's Value, Font Color
or Fill Color in Excel 2007
Ron de Bruin (last update 9-Oct-2008)
Go back to the Excel tips page
You can find the information from this page also in my MSDN article:
http://msdn.microsoft.com/en-us/library/cc952296.aspx

In Excel 2007 there are new commands on the Cell menu that make it easy to filter
a table based on the active cell's value, font color or fill color.
This article discusses how you can access these features with a macro.

The Cell menu is the menu that pops up when you right click a cell:



Note: There are two ways that a cell's font or fill color can be set.
One is by the Fill and Font controls in the Font group on the Home tab.
The other is by Conditional Formatting in the Styles group on the Home tab.
The great thing about the new color filtering features is that it works with colors set either way.

When you select one of the filter options on the Cell menu Excel will guess what your
filter range is if you've selected only a single cell.
If you have any empty rows in your table Excel may not select the range you intend.



How do I access these features with a macro

In the basic example below I show how to use one of the built-in options in your VBA code using the Commandbars Execute method. Why not use the Range AutoFilter method instead?
The problem with the AutoFilter method is that it requires you to specify the font or fill color of the active cell.
That's easy to do when the colors are set by the Font group controls, but when the colors are set because of Conditional Formatting it is impractical, if not near impossible, to do.

Why? Because Excel does not give us a direct way to tell in code what font or fill colors a cell is displaying
as a result of conditional formatting. Our code would have to work through the conditional formatting rules
and figure out the one in effect, if any, and then figure out the formatting applied, if any. It is much easy to
use the Execute method and have Excel do all this work.

The code example will create a new worksheet or workbook with every record with the same
Fill interior color/Pattern or Shading style of the active cell.

You can change the number in this part of the macro if you want to filter on the font color or value.
        'Call the built-in filter option to filter on ACell
        Application.CommandBars("Cell").FindControl _
                (ID:=12233, Recursive:=True).Execute
Control Id      Description
12232          Filter by Selected Cell's Value
12233          Filter by Selected Cell's Color
12234          Filter by Selected Cell's Font Color
12235          Filter by Selected Cell's Icon


Why do I use the Control Id instead of the control caption ?
If you use the ID the code will work in every language version of Excel

How do you find the Id number of a control in the Cell menu?
You already have the ID numbers but maybe useful to know.
I like to use this add-in (CommandBar Tools) to find ID numbers.
http://www.erlandsendata.no/downloads/commandbartools.zip

When you open the add-in in Excel 2007 you can find the menu on the Add-ins tab
Click on EDC Tools > Commandbars....List all Commandbars controls
Select Cell(36-153) and click on OK

Tip: See also the tips part below the macro on this page.
Maybe there is something useful there for you if you want to change the code.


VBA code example

In my example code I filter on the Fill interior color/Pattern or Shading style.
Note: this is new for me also so suggestions are welcome.

Select a cell with a Fill interior color/Pattern or Shading style and Run the macro.
The macro will create a new worksheet for you with the filter results.
Every time you run the code it will delete the worksheet first so you are
sure that the worksheet have the latest filter results.

Read this part in the macro good "Optional set the Filter range"

If there are empty rows or columns in your data in a normal range you
can make sure that Excel uses the correct data range here.
Sub Filter_Example_Excel2007()
    Dim ACell As Range
    Dim WSNew As Worksheet
    Dim Rng As Range
    Dim ActiveCellInTable As Boolean

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

    'Delete the sheet MyFilterResult if it exists
    On Error Resume Next
    Application.DisplayAlerts = False
    Sheets("MyFilterResult").Delete
    Application.DisplayAlerts = True
    On Error GoTo 0

    'Remember the activecell
    Set ACell = ActiveCell

    'Test if ACell is in a Table or in a Normal range
    On Error Resume Next
    ActiveCellInTable = (ACell.ListObject.Name <> "")
    On Error GoTo 0

    'Optional set the Filter range
    If ActiveCellInTable = False Then
        'Your data is in a Normal range.

        'If there are empty rows or columns in your data range you
        'can make sure that Excel uses the correct data range here.
        'If you do not use these three lines Excel will guess what
        'your range is. Here we assume that A1 is the top left cell
        'of your filter range and the header of the first column and
        'that C is the last column in the filter range

        '        Set Rng = Range("A1:C" & ActiveSheet.Rows.Count)
        '        Rng.Select
        '        ACell.Activate
    Else
        'Your data is in a Table

        'No problem if there are empty rows or columns if your data.
        'is in a Table so there is no need to set a range because
        'it automatically uses the whole table.
    End If


    'Call the built-in filter option to filter on ACell
    Application.CommandBars("Cell").FindControl _
            (ID:=12233, Recursive:=True).Execute

    'Control Id      Description
    '12232          Filter by Selected Cell's Value
    '12233          Filter by Selected Cell's Color
    '12234          Filter by Selected Cell's Font Color
    '12235          Filter by Selected Cell's Icon

    ACell.Select

    'Copy the Visible data into a new worksheet
    If ActiveCellInTable = False Then
        On Error Resume Next
        ACell.Parent.AutoFilter.Range.Copy
        If Err.Number > 0 Then
            MsgBox "Select a cell in your data range"
            With Application
                .ScreenUpdating = True
                .EnableEvents = True
            End With
            Exit Sub
        End If
    Else
        ACell.ListObject.Range.SpecialCells(xlCellTypeVisible).Copy
    End If

    'Add a new worksheet to copy the filter results in
    Set WSNew = Worksheets.Add
    WSNew.Name = "MyFilterResult"

    With WSNew.Range("A1")
        .PasteSpecial xlPasteColumnWidths
        .PasteSpecial xlPasteValues
        .PasteSpecial xlPasteFormats
        Application.CutCopyMode = False
        .Select
    End With

    'Close AutoFilter
    ACell.AutoFilter

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

End Sub


Tips

Create a workbook instead of a worksheet
If you want to create a new Workbook with the filter results instead of a Worksheet then
change this in the example macros.

Delete this part
        'Delete the sheet MyFilterResult if it exists
        On Error Resume Next
        Application.DisplayAlerts = False
        Sheets("MyFilterResult").Delete
        Application.DisplayAlerts = True
        On Error GoTo 0
And replace this line
    Set WSNew = Worksheets.Add

With
    Set WSNew = Workbooks.Add.Worksheets(1)