Copying a Subset of Columns and Reordering

If you are doing the AdvancedFilter to send records to a report, it is likely that you may 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 AdvancedFilter produces data, as shown in Figure 11.18. 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. The final report is shown in Figure 11.19.

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 1 Find the size of today's dataset FinalRow = Cells(65536, 1).End(xlUp).Row NextCol = Cells(1, 255).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 11.18

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

0 0

Post a comment