To extract a unique list of values, follow these steps:

By default, Excel copies all the columns in the dataset. You can filter just the Customer column by either limiting the List Range to include only Column D, or by specifying one or more headings in the Copy To range. Either method has its own drawbacks.

Change the List Range to a Single Column

With a little forethought before invoking the Advanced Filter command, you can allow Excel to keep the default list range of $A$1:$H$1127. In cell J1, type the Customer heading. In Figure 12.2, you leave the List Range field pointing to Columns A through H. Because the Copy To range of J1 already contains a valid heading from the list range, Excel copies data only from the Customer column. I prefer this method, particularly if you will be doing multiple advanced filters. Because Excel remembers the prior settings from the last advanced filter, it is more convenient to always filter the entire columns of the list range and limit the columns by setting up headings in the Copy To range.

Figure 12.2. By setting up a heading in the Copy To range of J1, you can avoid having to respecify the list range for each advanced filter.

After using either of these methods to perform the Advanced Filter, a concise list of the unique customers appears in Column J (see Figure 12.3).

Figure 12.3. The Advanced Filter extracted a unique list of customers from the dataset and copied it to Column J.

In VBA, you use the AdvancedFilter method to carry out the Advanced Filter command. Again, you have three choices to make:

The following code sets up a single column output range two columns to the right of the last-used column in the data range:

Sub GetUniqueCustomers()
    Dim IRange As Range
    Dim ORange As Range

    ' Find the size of today's dataset
    FinalRow = Cells(Rows.Count, 1).End(xlUp).Row
    NextCol = Cells(1, Columns.Count).End(xlToLeft).Column + 2

    ' Set up output range. Copy heading from D1 there
    Range("D1").Copy Destination:=Cells(1, NextCol)
    Set ORange = Cells(1, NextCol)

    ' Define the Input Range
    Set IRange = Range("A1").Resize(FinalRow, NextCol - 2)

    ' Do the Advanced Filter to get unique list of customers
    IRange.AdvancedFilter Action:=xlFilterCopy, CopyToRange:=ORange, Unique:=True

End Sub

By default, an advanced filter copies all columns. If you just want one particular column, use that column heading as the heading in the output range.

The first bit of code finds the final row and column in the dataset. Although it is not necessary to do so, I define an object variable for the output range (ORange) and for the input range (IRange).

This code is generic enough that it will not have to be rewritten if new columns are added to the dataset at a later time. Setting up the object variables for the input and output range is done for readability instead of out of necessity. The previous code could be written just as easily like this shortened version:

Sub UniqueCustomerRedux()
    ' Copy a heading to create an output range
    Range("J1").Value = Range("D1").Value
    ' Do the Advanced Filter
    Range("A1").CurrentRegion.AdvancedFilter xlFilterCopy, _
        CopyToRange:=Range("J1"), Unique:=True
End Sub

When you run either of the previous blocks of code on the sample dataset, you get a unique list of customers off to the right of the data. In Figure 12.3, you saw the original dataset in Columns A:H and the unique customers in Column J. The key to getting a unique list of customers is copying the header from the Customer field to a blank cell and specifying this cell as the output range.

After you have the unique list of customers, you can easily sort the list and add a SUMIF formula to get total revenue by customer. The following code gets the unique list of customers, sorts it, and then builds a formula to total revenue by customer. Figure 12.4 shows the results:

Sub RevenueByCustomers()
    Dim IRange As Range
    Dim ORange As Range

    ' Find the size of today's dataset
    FinalRow = Cells(Rows.Count, 1).End(xlUp).Row
    NextCol = Cells(1, Columns.Count).End(xlToLeft).Column + 2

    ' Set up output range. Copy heading from D1 there
    Range("D1").Copy Destination:=Cells(1, NextCol)
    Set ORange = Cells(1, NextCol)

    ' Define the Input Range
    Set IRange = Range("A1").Resize(FinalRow, NextCol - 2)

    ' Do the Advanced Filter to get unique list of customers
    IRange.AdvancedFilter Action:=xlFilterCopy, _
        CopyToRange:=ORange, Unique:=True

    ' Determine how many unique customers we have
    LastRow = Cells(Rows.Count, NextCol).End(xlUp).Row

    ' Sort the data
    Cells(1, NextCol).Resize(LastRow, 1).Sort Key1:=Cells(1, NextCol), _
        Order1:=xlAscending, Header:=xlYes

    ' Add a SUMIF formula to get totals
    Cells(1, NextCol + 1).Value = "Revenue"
    Cells(2, NextCol + 1).FormulaR1C1 = "=SUM(R2C4:R" & FinalRow & "C4,RC[-1], _
        R2C6:R" & FinalRow & "C6)"
    If LastRow > 2 Then
        Cells(2, NextCol + 1).Copy Cells(3, NextCol + 1).Resize(LastRow - 2, 1)
    End If

End Sub

Figure 12.4. This simple macro produced a summary report by customer from a lengthy dataset. Using AdvancedFilter is the key to powerful macros such as these.

Another use of a unique list of values is to quickly populate a list box or a combo box on a userform. Suppose, for instance, that you have a macro that can run a report for any one specific customer. To allow your clients to choose which customers to report, create a simple userform. Add a list box to the userform and set the list box’s MultiSelect property to 1-fmMultiSelectMulti. I named my form frmReport. In addition to the list box, I have four command buttons: OK, Cancel, Mark All, Clear All. The code to run the form follows. Note the Userform_Initialize procedure includes an advanced filter to get the unique list of customers from the dataset:

Private Sub CancelButton_Click()
    Unload Me
End Sub

Private Sub cbSubAll_Click()
    For i = 0 To lbCust.ListCount - 1
        Me.lbCust.Selected(i) = True
    Next i
End Sub

Private Sub cbSubClear_Click()
    For i = 0 To lbCust.ListCount - 1
        Me.lbCust.Selected(i) = False
    Next i
End Sub

Private Sub OKButton_Click()
    For i = 0 To lbCust.ListCount - 1
        If Me.lbCust.Selected(i) = True Then
            ' Call a routine to produce this report
            RunCustReport WhichCust:=Me.lbCust.List(i)
        End If
    Next i
    Unload Me
End Sub

Private Sub UserForm_Initialize()
    Dim IRange As Range
    Dim ORange As Range

    ' Find the size of today's dataset
    FinalRow = Cells(Rows.Count, 1).End(xlUp).Row
    NextCol = Cells(1, Columns.Count).End(xlToLeft).Column + 2

    ' Set up output range. Copy heading from D1 there
    Range("D1").Copy Destination:=Cells(1, NextCol)
    Set ORange = Cells(1, NextCol)

    ' Define the Input Range
    Set IRange = Range("A1").Resize(FinalRow, NextCol - 2)

    ' Do the Advanced Filter to get unique list of customers
    IRange.AdvancedFilter Action:=xlFilterCopy, _
        CopyToRange:=ORange, Unique:=True

    ' Determine how many unique customers we have
    LastRow = Cells(Rows.Count, NextCol).End(xlUp).Row

    ' Sort the data
    Cells(1, NextCol).Resize(LastRow, 1).Sort Key1:=Cells(1, NextCol), _
        Order1:=xlAscending, Header:=xlYes

With Me.lbCust
    .RowSource = ""
    .List = Cells(2, NextCol).Resize(LastRow - 1, 1).Value
End With

    ' Erase the temporary list of customers
    Cells(1, NextCol).Resize(LastRow, 1).Clear
End Sub

Launch this form with a simple module such as this:

Sub ShowCustForm()
    frmReport.Show
End Sub

Your clients are presented with a list of all valid customers from the dataset. Because the list box’s MultiSelect property is set to allow it, they can select any number of customers, as shown in Figure 12.5.

Figure 12.5. Your clients will have a list of customers from which to select quickly. Using an advanced filter on even a 1,000,000-row dataset is much faster than setting up a class to populate the list box.

To get all unique combinations of two (or more) fields, build the output range to include the additional fields. This code sample builds a list of unique combinations of two fields, Customer and Product:

Sub UniqueCustomerProduct()
    Dim IRange As Range
    Dim ORange As Range

    ' Find the size of today's dataset
    FinalRow = Cells(Rows.Count, 1).End(xlUp).Row
    NextCol = Cells(1, Columns.Count).End(xlToLeft).Column + 2

    ' Set up output range. Copy headings from D1 & B1
    Range("D1").Copy Destination:=Cells(1, NextCol)
    Range("B1").Copy Destination:=Cells(1, NextCol + 1)
    Set ORange = Cells(1, NextCol).Resize(1, 2)

    ' Define the Input Range
    Set IRange = Range("A1").Resize(FinalRow, NextCol - 2)

    ' Do the Advanced Filter to get unique list of customers & product
    IRange.AdvancedFilter Action:=xlFilterCopy, _
        CopyToRange:=ORange, Unique:=True

    ' Determine how many unique rows we have
    LastRow = Cells(Rows.Count, NextCol).End(xlUp).Row

    ' Sort the data
    Cells(1, NextCol).Resize(LastRow, 2).Sort Key1:=Cells(1, NextCol), _
        Order1:=xlAscending, Key2:=Cells(1, NextCol + 1), _
        Order2:=xlAscending, Header:=xlYes

End Sub

In the result shown in Figure 12.6, you can see that Enhanced Eggbeater buys only one product, and Agile Aquarium buys three products. This might be useful to use as a guide in running reports on either customer by product or product by customer.

Figure 12.6. By including two columns in the output range on a Unique Values query, we get every combination of Customer and Product.

You may want to filter records that match one criteria or another (for example, extract customers who purchased either product M556 or product R537). This is called a logical OR criteria.

When your criteria should be joined by a logical OR, place the criteria on subsequent rows of the criteria range. For example, the criteria range shown in J1:J3 of Figure 12.9 tells you which customers order product M556 or product R537.

Figure 12.9. Place criteria on successive rows to join them with an OR. This criteria range gets customers who ordered either product M556 or R537.

Other times, you will want to filter records that match one criteria and another criteria. For example, you might want to extract records where the product sold was W435 and the region was the West region. This is called a logical AND.

To join two criteria by AND, put both criteria on the same row of the criteria range. For example, the criteria range shown in J1:K2 of Figure 12.10 gets the customers who ordered product W435 in the West region.

Figure 12.10. Place criteria on the same row to join them with an AND. The criteria range in J1:K2 gets customers from the West region who ordered product W435.

The criteria range shown in Figure 12.11 is based on two different fields. They are joined with an OR. The query finds all records from either the West region or records where the product is W435.

Figure 12.11. The criteria range in J1:K3 returns records where either the Region is West or the Product is W435.

It is possible to have a criteria range with multiple logical AND and logical OR criteria joined together. Although this might work in some situations, in other scenarios it quickly gets out of hand. Luckily, Excel allows for criteria where the records are selected as the result of a formula to handle this situation.

Working with Very Complex Criteria

Your clients so loved the “Create a Customer” report, they hired you to write a new report. In this case, they could select any customer, any product, any region, or any combination of them. You can quickly adapt the frmReport userform to show three list boxes, as shown in Figure 12.12.

Figure 12.12. This super-flexible form lets clients run any types of reports that they can imagine. It creates some nightmarish criteria ranges, unless you know the way out.

In your first test, imagine that you select two customers and two products. In this case, your program has to build a five-row criteria range, as shown in Figure 12.13. This isn’t too bad.

Figure 12.13. This criteria range returns any records where the two selected customers ordered any of the two selected products.

This gets crazy if someone selects 10 products, all regions but the house region, and all customers except the internal customer. Your criteria range would need unique combinations of the selected fields. This could easily be 10 products times 9 regions times 499 customers, or more than 44,000 rows of criteria range. You can quickly end up with a criteria range that spans thousands of rows and three columns. I was once foolish enough to actually try running an advanced filter with such a criteria range. It would still be trying to compute if I hadn’t rebooted the computer.

The solution for this report is to replace the lists of values with a formula-based condition.

Using Formula-Based Conditions with VBA

The following is the code for this new userform. Note the logic in OKButton_Click that builds the formula. Figure 12.14 shows the Excel sheet just before the Advanced Filter is run:

Private Sub CancelButton_Click()
    Unload Me
End Sub

Private Sub cbSubAll_Click()
    For i = 0 To lbCust.ListCount - 1
        Me.lbCust.Selected(i) = True
    Next i
End Sub

Private Sub cbSubClear_Click()
    For i = 0 To lbCust.ListCount - 1
        Me.lbCust.Selected(i) = False
    Next i
End Sub

Private Sub CommandButton1_Click()
    ' Clear all products
    For i = 0 To lbProduct.ListCount - 1
        Me.lbProduct.Selected(i) = False
    Next i
End Sub

Private Sub CommandButton2_Click()
    ' Mark all products
    For i = 0 To lbProduct.ListCount - 1
        Me.lbProduct.Selected(i) = True
    Next i
End Sub

Private Sub CommandButton3_Click()
    ' Clear all regions
    For i = 0 To lbRegion.ListCount - 1
        Me.lbRegion.Selected(i) = False
    Next i
End Sub

Private Sub CommandButton4_Click()
    ' Mark all regions
    For i = 0 To lbRegion.ListCount - 1
        Me.lbRegion.Selected(i) = True
    Next i
End Sub

Private Sub OKButton_Click()
    Dim CRange As Range, IRange As Range, ORange As Range
    ' Build a complex criteria that ANDS all choices together
    NextCCol = 10
    NextTCol = 15

    For j = 1 To 3
        Select Case j
            Case 1
                MyControl = "lbCust"
                MyColumn = 4
            Case 2
                MyControl = "lbProduct"
                MyColumn = 2
            Case 3
                MyControl = "lbRegion"
                MyColumn = 1
        End Select
        NextRow = 2
        ' Check to see what was selected.
        For i = 0 To Me.Controls(MyControl).ListCount - 1
            If Me.Controls(MyControl).Selected(i) = True Then
                Cells(NextRow, NextTCol).Value = _
                    Me.Controls(MyControl).List(i)
                NextRow = NextRow + 1
            End If
        Next i
        ' If anything was selected, build a new criteria formula
        If NextRow > 2 Then
            ' the reference to Row 2 must be relative in order to work
            MyFormula = "=NOT(ISNA(MATCH(RC" & MyColumn & ",R2C" & NextTCol & _
                ":R" & NextRow - 1 & "C" & NextTCol & ",False)))"
            Cells(2, NextCCol).FormulaR1C1 = MyFormula
            NextTCol = NextTCol + 1
            NextCCol = NextCCol + 1
        End If
    Next j
    Unload Me

    ' Figure 12.14 shows the worksheet at this point
    ' if we built any criteria, define the criteria range
    If NextCCol > 10 Then
        Set CRange = Range(Cells(1, 10), Cells(2, NextCCol - 1))
        Set IRange = Range("A1").CurrentRegion
        Set ORange = Cells(1, 20)
        IRange.AdvancedFilter xlFilterCopy, CRange, ORange

        ' Clear out the criteria
        Cells(1, 10).Resize(1, 10).EntireColumn.Clear
    End If

    ' At this point, the matching records are in T1

End Sub

Private Sub UserForm_Initialize()
    Dim IRange As Range
    Dim ORange As Range

    ' Find the size of today's dataset
    FinalRow = Cells(Rows.Count, 1).End(xlUp).Row
    NextCol = Cells(1, Columns.Count).End(xlToLeft).Column + 2

    ' Define the input range
    Set IRange = Range("A1").Resize(FinalRow, NextCol - 2)

    ' Set up output range for Customer. Copy heading from D1 there
    Range("D1").Copy Destination:=Cells(1, NextCol)
    Set ORange = Cells(1, NextCol)

    ' Do the Advanced Filter to get unique list of customers
    IRange.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:="", _
        CopyToRange:=ORange, Unique:=True

    ' Determine how many unique customers we have
    LastRow = Cells(Rows.Count, NextCol).End(xlUp).Row

    ' Sort the data
    Cells(1, NextCol).Resize(LastRow, 1).Sort Key1:=Cells(1, NextCol), _
        Order1:=xlAscending, Header:=xlYes

    With Me.lbCust
        .RowSource = ""
        FinalRow = Cells(Rows.Count, 10).End(xlUp).Row
        For Each cell In Cells(2, NextCol).Resize(LastRow - 1, 1)
            .AddItem cell.Value
        Next cell
    End With

    ' Erase the temporary list of customers
    Cells(1, NextCol).Resize(LastRow, 1).Clear

    ' Set up output range for product. Copy heading from D1 there
    Range("B1").Copy Destination:=Cells(1, NextCol)
    Set ORange = Cells(1, NextCol)

    ' Do the Advanced Filter to get unique list of customers
    IRange.AdvancedFilter Action:=xlFilterCopy, _
        CopyToRange:=ORange, Unique:=True

    ' Determine how many unique customers we have
    LastRow = Cells(Rows.Count, NextCol).End(xlUp).Row

    ' Sort the data
    Cells(1, NextCol).Resize(LastRow, 1).Sort Key1:=Cells(1, NextCol), _
        Order1:=xlAscending, Header:=xlYes

    With Me.lbProduct
        .RowSource = ""
        FinalRow = Cells(Rows.Count, 10).End(xlUp).Row
        For Each cell In Cells(2, NextCol).Resize(LastRow - 1, 1)
            .AddItem cell.Value
        Next cell
    End With

    ' Erase the temporary list of customers
    Cells(1, NextCol).Resize(LastRow, 1).Clear

    ' Set up output range for Region. Copy heading from A1 there
    Range("A1").Copy Destination:=Cells(1, NextCol)
    Set ORange = Cells(1, NextCol)

    ' Do the Advanced Filter to get unique list of customers
    ' Figure 12.15 shows the worksheet state just before this line
    IRange.AdvancedFilter Action:=xlFilterCopy, CopyToRange:=ORange, _
        Unique:=True

    ' Determine how many unique customers we have
    LastRow = Cells(Rows.Count, NextCol).End(xlUp).Row

    ' Sort the data
    Cells(1, NextCol).Resize(LastRow, 1).Sort Key1:=Cells(1, NextCol), _
        Order1:=xlAscending, Header:=xlYes

    With Me.lbRegion
        .RowSource = ""
        FinalRow = Cells(Rows.Count, 10).End(xlUp).Row
        For Each cell In Cells(2, NextCol).Resize(LastRow - 1, 1)
            .AddItem cell.Value
        Next cell
    End With

    ' Erase the temporary list of customers
    Cells(1, NextCol).Resize(LastRow, 1).Clear

End Sub

Figure 12.14 shows the worksheet just before the AdvancedFilter method is called. The user has selected customers, products, and regions. The macro has built temporary tables in Columns O, P, Q to show which values the user selected. The criteria range is J1:L2. That criteria formula in J2 looks to see whether the value in $D2 is in the list of selected customers in O. The formulas in K2 and L2 compare $B2 to Column P and $A2 to Column Q.

Figure 12.14. The worksheet just before the macro runs the advanced filter.

Caution

Excel VBA Help says that if you do not specify a criteria range, no criteria is used. This is not true in Excel 2007—if no criteria range is specified, the advanced filter inherits the criteria range from the prior advanced filter. You should include CriteriaRange:="" to clear the prior value.

=$A2>Average($A$2:$A$60000)

Just as when using Copy, you have to watch out for the possibility of having no records match the criteria. In this case, however, it is more difficult to realize that nothing is returned. You generally find out when the .SpecialCells method returns a runtime error 1004—no cells were found.

To catch this condition, you have to set up an error trap to anticipate the 1004 error with the SpecialCells method. (See Chapter 25, “Handling Errors,” for more information on catching errors.)

    On Error GoTo NoRecs
    For Each cell In Range("A2:A" & FinalRow).SpecialCells(xlCellTypeVisible)
        Ctr = Ctr + 1
    Next cell
    On Error GoTo 0
    MsgBox Ctr & " cells match the criteria"
    Exit Sub
NoRecs:
    MsgBox "No records match the criteria"
End Sub

This error trap works because I specifically exclude the header row from the SpecialCells range. The header row is always visible after an advanced filter. Including it in the range would prevent the 1004 error from being raised.

After doing a Filter in Place, you can get all records to show again by using the ShowAllData method:

ActiveSheet.ShowAllData

It is possible to use Filter in Place and Unique Records Only. However, when you specified an output range of only Product and Customer, the advanced filter was able to give you only the unique combinations of Customer and Product. If you ask for unique records from a dataset with 10 fields, the only records that will not be shown are those records where all 10 fields are exact duplicates.

To copy all columns, specify a single blank cell as the output range. You will get all columns for those records that match the criteria as shown in Figure 12.16:

Sub AllColumnsOneCustomer()
    Dim IRange As Range
    Dim ORange As Range
    Dim CRange As Range

    ' Find the size of today's dataset
    FinalRow = Cells(Rows.Count, 1).End(xlUp).Row
    NextCol = Cells(1, Columns.Count).End(xlToLeft).Column + 2

    ' Set up the criteria range with one customer
    Cells(1, NextCol).Value = Range("D1").Value
    ' In reality, this value should be passed from the userform
    Cells(2, NextCol).Value = Range("D2").Value
    Set CRange = Cells(1, NextCol).Resize(2, 1)

    ' Set up output range. It is a single blank cell
    Set ORange = Cells(1, NextCol + 2)

    ' Define the Input Range
    Set IRange = Range("A1").Resize(FinalRow, NextCol - 2)

    ' Do the Advanced Filter to get unique list of customers & product
    IRange.AdvancedFilter Action:=xlFilterCopy, _
        CriteriaRange:=CRange, CopyToRange:=ORange


End Sub

Figure 12.16. When using xlFilterCopy with a blank output range, you get all columns in the same order as they appear in the original list range.

If you are doing the advanced filter to send records to a report, it is likely that you might only need a subset of columns and you might need them in a different sequence.

Here is an example that will finish off the frmReport example from earlier in the chapter. As you remember, frmReport would allow the client to select a customer. The OK button would then call the RunCustReport routine, passing a parameter to identify for which customer to prepare a report.

Imagine this is a report being sent to the customer. The customer really doesn’t care about the surrounding region, and we definitely do not want to reveal our cost of goods sold or profit. Assuming that we will put the customer in the title of the report, the fields that we really need to produce the report are Date, Quantity, Product, Revenue.

The following code copies those headings to the output range. The advanced filter produces data, as shown in Figure 12.17. The program then goes on to copy the matching records to a new workbook. A title and total row is added, and the report is saved with the customer’s name. Figure 12.18 shows the final report.

Sub RunCustReport(WhichCust As Variant)
    Dim IRange As Range
    Dim ORange As Range
    Dim CRange As Range
    Dim WBN As Workbook
    Dim WSN As Worksheet
    Dim WSO As Worksheet

    Set WSO = ActiveSheet
    ' Find the size of today's dataset
    FinalRow = Cells(Rows.Count, 1).End(xlUp).Row
    NextCol = Cells(1, Columns.Count).End(xlToLeft).Column + 2

    ' Set up the criteria range with one customer
    Cells(1, NextCol).Value = Range("D1").Value
    Cells(2, NextCol).Value = WhichCust
    Set CRange = Cells(1, NextCol).Resize(2, 1)

    ' Set up output range. We want Date, Quantity, Product, Revenue
    ' These columns are in C, E, B, and F
    Cells(1, NextCol + 2).Resize(1, 4).Value = _
        Array(Cells(1, 3), Cells(1, 5), Cells(1, 2), Cells(1, 6))
    Set ORange = Cells(1, NextCol + 2).Resize(1, 4)

    ' Define the Input Range
    Set IRange = Range("A1").Resize(FinalRow, NextCol - 2)

    ' Do the Advanced Filter to get unique list of customers & products
    IRange.AdvancedFilter Action:=xlFilterCopy, _
        CriteriaRange:=CRange, CopyToRange:=ORange

    ' At this point, the data looks like Figure 12.18

    ' Create a new workbook with one blank sheet to hold the output
    Set WBN = Workbooks.Add(xlWBATWorksheet)
    Set WSN = WBN.Worksheets(1)

    ' Set up a title on WSN
    WSN.Cells(1, 1).Value = "Report of Sales to " & WhichCust

    ' Copy data from WSO to WSN
    WSO.Cells(1, NextCol + 2).CurrentRegion.Copy Destination:=WSN.Cells(3, 1)
    TotalRow = WSN.Cells(Rows.Count, 1).End(xlUp).Row + 1
    WSN.Cells(TotalRow, 1).Value = "Total"
    WSN.Cells(TotalRow, 2).FormulaR1C1 = "=SUM(R2C:R[-1]C)"
    WSN.Cells(TotalRow, 4).FormulaR1C1 = "=SUM(R2C:R[-1]C)"

    ' Format the new report with bold
    WSN.Cells(3, 1).Resize(1, 4).Font.Bold = True
    WSN.Cells(TotalRow, 1).Resize(1, 4).Font.Bold = True
    WSN.Cells(1, 1).Font.Size = 18

    WBN.SaveAs "C:" & WhichCust & ".xls"
    WBN.Close SaveChanges:=False

    WSO.Select

    ' clear the output range, etc.
    Range("J1:Z1").EntireColumn.Clear

End Sub

Figure 12.17. Immediately after the advanced filter, we have just the columns and records needed for the report.

Figure 12.18. After copying the filtered data to a new sheet and applying some formatting, we have a good-looking report to send to each customer.

Utilizing Two Kinds of Advanced Filters to Create a Report for Each Customer

The final advanced filter example for this chapter uses several advanced filter techniques. Let’s say that after importing invoice records, you want to send a purchase summary to each customer. The process would be as follows:

1. Run an advanced filter requesting unique values to get a list of customers in J. This AdvancedFilter would specify the Unique:=True parameter and use a CopyToRange that includes a single heading for Customer:

   ' Set up output range. Copy heading from D1 there
   Range("D1").Copy Destination:=Cells(1, NextCol)
   Set ORange = Cells(1, NextCol)
   
   ' Define the Input Range
   Set IRange = Range("A1").Resize(FinalRow, NextCol - 2)
   
   ' Do the Advanced Filter to get unique list of customers
   IRange.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:="", _
       CopyToRange:=ORange, Unique:=True

2. For each customer in the list of unique customers in Column J, perform steps 3 through 7. Find the number of customers in the output range from step 1. Then, use a For Each Cell loop to loop through the customers:

   ' Loop through each customer
   FinalCust = Cells(Rows.Count, NextCol).End(xlUp).Row
   For Each cell In Cells(2, NextCol).Resize(FinalCust - 1, 1)
       ThisCust = cell.Value
       ' ... Steps 3 through 7 here
   Next Cell

3. Build a criteria range in L1:L2 to be used in a new advanced filter. The criteria range would include a heading of Customer in L1 and the customer name from this iteration of the loop in cell L2:

   ' Set up the Criteria Range with one customer
   Cells(1, NextCol + 2).Value = Range("D1").Value
   Cells(2, NextCol + 2).Value = ThisCust
   Set CRange = Cells(1, NextCol + 2).Resize(2, 1)

4. Do an advanced filter to copy matching records for this customer to Column N. This Advanced Filter statement would specify the Unique:=False parameter. Because we want only the columns for Date, Quantity, Product, and Revenue, the CopyToRange specifies a four-column range with those headings copied in the proper order:

   ' Set up output range. We want Date, Quantity, Product, Revenue
   ' These columns are in C, E, B, and F
   Cells(1, NextCol + 4).Resize(1, 4).Value = _
       Array(Cells(1, 3), Cells(1, 5), Cells(1, 2), Cells(1, 6))
   Set ORange = Cells(1, NextCol + 4).Resize(1, 4)
   
   ' Do the Advanced Filter to get unique list of customers & product
   IRange.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=CRange, _
       CopyToRange:=Orange

5. Copy the customer records to a report sheet in a new workbook. The VBA code uses the Workbooks.Add method to create a new blank workbook. The extracted records from step 4 are copied to cell A3 of the new workbook:

   ' Create a new workbook with one blank sheet to hold the output
   Set WBN = Workbooks.Add(xlWBATWorksheet)
   Set WSN = WBN.Worksheets(1)
   
   ' Copy data from WSO to WSN
   WSO.Cells(1, NextCol + 4).CurrentRegion.Copy _
       Destination:=WSN.Cells(3, 1)

6. Format the report with a title and totals. In VBA, add a title that reflects the customer’s name in cell A1. Make the headings bold and add a total below the final row:

   ' Set up a title on WSN
   WSN.Cells(1, 1).Value = "Report of Sales to " & ThisCust
   
   TotalRow = WSN.Cells(Rows.Count, 1).End(xlUp).Row + 1
   WSN.Cells(TotalRow, 1).Value = "Total"
   WSN.Cells(TotalRow, 2).FormulaR1C1 = "=SUM(R2C:R[-1]C)"
   WSN.Cells(TotalRow, 4).FormulaR1C1 = "=SUM(R2C:R[-1]C)"
   
   ' Format the new report with bold
   WSN.Cells(3, 1).Resize(1, 4).Font.Bold = True
   WSN.Cells(TotalRow, 1).Resize(1, 4).Font.Bold = True
   WSN.Cells(1, 1).Font.Size = 18

7. Use SaveAs to save the workbook based on customer name. After the workbook is saved, close the new workbook. Return to the original workbook and clear the output range to prepare for the next pass through the loop:

   WBN.SaveAs "C:Reports" & ThisCust & ".xls"
   WBN.Close SaveChanges:=False
   
   WSO.Select
   Set WSN = Nothing
   Set WBN = Nothing
   
   ' clear the output range, etc.
   Cells(1, NextCol + 2).Resize(1, 10).EntireColumn.Clear

   The complete code is as follows:

   Sub RunReportForEachCustomer()
       Dim IRange As Range
       Dim ORange As Range
       Dim CRange As Range
       Dim WBN As Workbook
       Dim WSN As Worksheet
       Dim WSO As Worksheet
   
       Set WSO = ActiveSheet
       ' Find the size of today's dataset
       FinalRow = Cells(Rows.Count, 1).End(xlUp).Row
       NextCol = Cells(1, Columns.Count).End(xlToLeft).Column + 2
   
       ' First - get a unique list of customers in J
       ' Set up output range. Copy heading from D1 there
       Range("D1").Copy Destination:=Cells(1, NextCol)
       Set ORange = Cells(1, NextCol)
   
       ' Define the Input Range
       Set IRange = Range("A1").Resize(FinalRow, NextCol - 2)
   
       ' Do the Advanced Filter to get unique list of customers
       IRange.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:="", _
           CopyToRange:=ORange, Unique:=True
   
       ' Loop through each customer
       FinalCust = Cells(Rows.Count, NextCol).End(xlUp).Row
       For Each cell In Cells(2, NextCol).Resize(FinalCust - 1, 1)
           ThisCust = cell.Value
   
           ' Set up the Criteria Range with one customer
           Cells(1, NextCol + 2).Value = Range("D1").Value
           Cells(2, NextCol + 2).Value = ThisCust
           Set CRange = Cells(1, NextCol + 2).Resize(2, 1)
   
           ' Set up output range. We want Date, Quantity, Product, Revenue
           ' These columns are in C, E, B, and F
           Cells(1, NextCol + 4).Resize(1, 4).Value = _
               Array(Cells(1, 3), Cells(1, 5), Cells(1, 2), Cells(1, 6))
           Set ORange = Cells(1, NextCol + 4).Resize(1, 4)
   
           ' Do the Advanced Filter to get unique list of customers & product
           IRange.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=CRange, _
               CopyToRange:=ORange
   
           ' Create a new workbook with one blank sheet to hold the output
           Set WBN = Workbooks.Add(xlWBATWorksheet)
           Set WSN = WBN.Worksheets(1)
   
           ' Copy data from WSO to WSN
           WSO.Cells(1, NextCol + 4).CurrentRegion.Copy _
               Destination:=WSN.Cells(3, 1)
   
           ' Set up a title on WSN
           WSN.Cells(1, 1).Value = "Report of Sales to " & ThisCust
   
           TotalRow = WSN.Cells(Rows.Count, 1).End(xlUp).Row + 1
           WSN.Cells(TotalRow, 1).Value = "Total"
           WSN.Cells(TotalRow, 2).FormulaR1C1 = "=SUM(R2C:R[-1]C)"
           WSN.Cells(TotalRow, 4).FormulaR1C1 = "=SUM(R2C:R[-1]C)"
   
           ' Format the new report with bold
           WSN.Cells(3, 1).Resize(1, 4).Font.Bold = True
           WSN.Cells(TotalRow, 1).Resize(1, 4).Font.Bold = True
           WSN.Cells(1, 1).Font.Size = 18
   
           WBN.SaveAs "C:Reports" & ThisCust & ".xlsx"
           WBN.Close SaveChanges:=False
   
           WSO.Select
           Set WSN = Nothing
           Set WBN = Nothing
   
           ' clear the output range, etc.
           Cells(1, NextCol + 2).Resize(1, 10).EntireColumn.Clear
       Next cell
   
       Cells(1, NextCol).EntireColumn.Clear
       MsgBox FinalCust - 1 & " Reports have been created!"
   End Sub

This is a remarkable 75 lines of code. Incorporating a couple of advanced filters and not much else, we’ve managed to produce a tool that created 27 reports in less than 1 minute (see Figure 12.19). Even an Excel power user would normally take 2 to 3 minutes per report to create these manually. In less than 60 seconds, this code easily will save someone a few hours every time these reports need to be created. Imagine the real scenario where there are hundreds of customers. I guarantee that there are people in every city who are manually creating these reports in Excel because they simply don’t realize the power of Excel VBA.

Figure 12.19. White-collar productivity would skyrocket if everyone knew how to create 27 reports in less than a minute.

There can be only one autofiltered dataset on each worksheet. To turn on the AutoFilter, you apply the AutoFilter method to any one cell in your dataset. For example, the following code turns on the AutoFilter drop-downs:

Range("A1").AutoFilter

The AutoFilter method is a toggle. If the AutoFilter drop-downs are already enabled, running the previous code will turn off the AutoFilter drop-downs. Excel 2007 adds a new FilterMode property, but it is only set to True if someone has selected a value from one of the AutoFilter drop-downs. Therefore, to figure out whether the AutoFilter is already enabled, you could the following macros to turn on/off the AutoFilter drop-downs:

Sub TurnOnAutoFilter()
    ' Turn on AutoFilters
    Worksheets("SalesReport").Select
    On Error Resume Next
    x = ActiveSheet.AutoFilter.Range.Areas.Count
    If Err.Number > 0 Then
        ActiveSheet.Range("A1").AutoFilter
    End If
    On Error Resume Next
End Sub

Use this code to turn off the AutoFilter drop-downs:

Sub TurnOffAutoFilter()
    ' Turn off AutoFilters
    Worksheets("SalesReport").Select
    On Error Resume Next
    x = ActiveSheet.AutoFilter.Range.Areas.Count
    If Err.Number = 0 Then
        ActiveSheet.Range("A1").AutoFilter
    End If
    On Error Resume Next
End Sub

One cool feature is available only in Excel VBA. When you AutoFilter a list in the Excel user interface, every column in the dataset gets a field drop-down in the heading row. Sometimes you have a field that doesn’t make a lot of sense to AutoFilter. For example, in our current dataset, you might want to provide AutoFilter drop-downs for Region, Product, Customer, but not the numeric or date fields. After setting up the AutoFilter, you need one line of code to turn off each drop-down that you do not want to appear. The following code turns off the drop-downs for Columns C, E, F, G, and H:

Sub AutoFilterCustom()
    Range("A1").AutoFilter Field:=3, VisibleDropDown:=False
    Range("A1").AutoFilter Field:=5, VisibleDropDown:=False
    Range("A1").AutoFilter Field:=6, VisibleDropDown:=False
    Range("A1").AutoFilter Field:=7, VisibleDropDown:=False
    Range("A1").AutoFilter Field:=8, VisibleDropDown:=False
End Sub

I think using this tool is a fairly rare treat. Most of the time, Excel VBA lets us do things that are possible in the user interface (although it lets us do them very rapidly). The VisibleDropDown parameter actually allows us to do something in VBA that is generally not available in the Excel user interface. Your knowledgeable clients will be scratching their heads trying to figure out how you set up the cool AutoFilter with only a few filterable columns (see Figure 12.20).

Figure 12.20. Using VBA, you can set up an AutoFilter where only certain columns have the AutoFilter drop-down.

In the earliest incarnation of AutoFilters, you would specify a column number, a criteria, an operator, and a second criteria. Because AutoFilters were limited to two conditions, this handled any possible filtering scenario.

For example, the following code filters to show records for the Agile Aquarium customer. As Customer is the fourth column in the dataset, the Field number is 4:

Sub SimpleFilter()
    Worksheets("SalesReport").Select
    Range("A1").AutoFilter
    Range("A1").AutoFilter Field:=4, _
        Criteria1:="=Agile Aquarium Inc."
End Sub

To clear the filter from the customer column, you use this code:

Sub SimpleFilter()
    Worksheets("SalesReport").Select
    Range("A1").AutoFilter
    Range("A1").AutoFilter Field:=4
End Sub

In previous versions of Excel, you could join two criteria with OR or AND operators. The following code would filter the customer column to one of two customers, joined by the OR operator:

Sub SimpleOrFilter()
    Worksheets("SalesReport").Select
    Range("A1").AutoFilter
    Range("A1").AutoFilter Field:=4, _
        Criteria1:="=Agile Aquarium Inc.", _
        Operator:=xlOr, Criteria2:="=Amazing Shoe Company"
End Sub

The following code returns all customers that started with the letters A through E:

Sub SimpleAndFilter()
    Worksheets("SalesReport").Select
    Range("A1").AutoFilter
    Range("A1").AutoFilter Field:=4, _
        Criteria1:=">=A", _
        Operator:=xlAnd, Criteria2:="<=EZZ"
End Sub

As the AutoFilter command became more flexible, Microsoft continued to use the same three parameters, even if they didn’t quite make sense. For example, Excel will let you filter a field by asking for the top five items or the bottom 8% of records. To use this type of filter, you specify either "5" or "8" as the Criteria1 argument, and then specify xlTop10Items, xlTop10Percent, xlBottom10Items, xlBottom10Percent as the operator. The following code produces the top 10 revenue records:

Sub Top10Filter()
    ' Top 12 Revenue Records
    Worksheets("SalesReport").Select
    Range("A1").AutoFilter
    Range("A1").AutoFilter Field:=6, _
        Criteria1:="12", _
        Operator:=xlTop10Items
End Sub

Excel 2007 offers several new filter options. Excel continues to force these filter options to fit in the old object model where the filter command must fit in an operator and up to two criteria fields.

If you specify three or more items from a filter drop-down, Excel VBA uses the xlFilterValues operator and specifies the complete list of selected items in an array passed to Criteria1. The following code selects five specific customers from the drop-down in D1:

Sub MultiSelectFilter()
    ' Select many customers
    Worksheets("SalesReport").Select
    Range("A1").AutoFilter
    Range("A1").AutoFilter Field:=4, _
        Criteria1:=Array( _
            "Amazing Shoe Company", "Cool Saddle Traders", _
            "Enhanced Eggbeater Corporation", _
            "First-Rate Notebook Inc.", "Handy Juicer Inc."), _
        Operator:=xlFilterValues
End Sub

Perhaps the most powerful feature in Excel 2007 filters is the new dynamic filters. These filters enable you to choose records that are above average or with a date field to select virtual periods such as Next Week or Last Year.

To use a dynamic filter, specify xlFilterDynamic as the operator and then use one of 34 values as Criteria1.

The following code finds all dates that are in next year:

Sub DynamicAutoFilter()
    Worksheets("SalesReport").Select
    Range("A1").AutoFilter
    Range("A1").AutoFilter Field:=3, _
        Criteria1:=xlFilterNextYear, _
        Operator:=xlFilterDynamic
End Sub

The following lists all the dynamic filter criteria options. Specify these values as Criteria1 in the AutoFilter method:

Unfortunately, you cannot combine criteria. You might think that you could specify xlFilterDatesInPeriodJanuary as Criteria1 and xlFilterDatesNextYear as Criteria2. Although this is a brilliant thought, Microsoft doesn’t support this syntax (yet).

Another new feature in Excel 2007 is the ability to filter based on font color, cell fill color, or conditional formatting icon.

If you are expecting the dataset to have an icon set applied, you can filter to show only records with one particular icon by using the xlFilterIcon operator.

For the criteria, you have to know which icon set has been applied and which icon within the set. The icon sets are identified using the names shown in Column A of Figure 12.21. The items range from 1 through 5. The following code filters the Revenue column to show the rows containing an upward-pointing arrow in the 5 Arrows Gray icon set:

Sub FilterByIcon()
    Worksheets("SalesReport").Select
    Range("A1").AutoFilter
    Range("A1").AutoFilter Field:=6, _
        Criteria1:=ActiveWorkbook.IconSets(xl5ArrowsGray).Item(5), _
        Operator:=xlFilterIcon
End Sub

Figure 12.21. To search for a particular icon, you need to know the icon set from Column A and the item number from Row 1.

To find records that have no conditional formatting icon, use an operator of xlFilterNoIcon and do not specify any criteria.

To find records that have a particular fill color, use an operator of xlFilterCellColor and specify a particular RGB value as the criteria. This code finds all red cells in Column F:

Sub FilterByFillColor()
    Worksheets("SalesReport").Select
    Range("A1").AutoFilter
    Range("A1").AutoFilter Field:=6, _
        Criteria1:=RGB(255, 0, 0), Operator:=xlFilterCellColor
End Sub

To find records that have no fill color, use an operator of xlFilterNoFill and do not specify any criteria.

To find records that have a particular font color, use an operator of xlFilterFontColor and specify a particular RGB value as the criteria. This code finds all cells with a red font in Column F:

Sub FilterByFontColor()
    Worksheets("SalesReport").Select
    Range("A1").AutoFilter
    Range("A1").AutoFilter Field:=6, _
        Criteria1:=RGB(255, 0, 0), Operator:=xlFilterFontColor
End Sub

To find records that have no particular font color, use an operator of xlFilterAutomaticFillColor and do not specify any criteria.

' Turn on the AutoFilter
WSO.Range("A1").AutoFilter
' Look for dates in column C
Range("A1").AutoFilter Field:=3, _
    Criteria1:=xlFilterNextWeek, _
    Operator:=xlFilterDynamic

WSO.AutoFilter.Range.SpecialCells(xlCellTypeVisible).Copy _
    Destination:=WSN.Cells(3, 1)

Sub AutoFilterNextWeekCopy()
    Dim WBN As Workbook
    Dim WSN As Worksheet
    Dim WSO As Worksheet

    Set WSO = ActiveSheet

    ' Turn on the AutoFilter
    WSO.Range("A1").AutoFilter
    ' Look for dates in column C

    Range("A1").AutoFilter Field:=3, _
        Criteria1:=xlFilterNextWeek, _
        Operator:=xlFilterDynamic

    ' Create a new workbook with one blank sheet to hold the output
    Set WBN = Workbooks.Add(xlWBATWorksheet)
    Set WSN = WBN.Worksheets(1)

   ' Set up a title on WSN
    WSN.Cells(1, 1).Value = "Projects Due Next Week"

    ' Copy data from WSO to WSN
    WSO.AutoFilter.Range.SpecialCells(xlCellTypeVisible).Copy _
        Destination:=WSN.Cells(3, 1)

    ' Format the new report with bold
    WSN.Cells(3, 1).Resize(1, FinalCol).Font.Bold = True
    WSN.Cells(1, 1).Font.Size = 18

    ' Save as a Macro-Enabled Workbook
    WBN.SaveAs "C:NextWeek.xlsm", xlOpenXMLWorkbookMacroEnabled

    ' Turn off the AutoFilter
    WSO.Range("A1").AutoFilter
End Sub