Info

Central 06f

Cas) AfiC

Central XY£

Central xt/

Central ARC

rasi nrr

West KVZ

Central ABC

fast XYZ

Central XYZ

Fast XYZ

Central ABC

Central ABC

Fast xyz

West ABC

cast ABC

Contrai X¥Z

Cast ABC

East DBF

Woit def

Contrai ABC

East ABC

Wfl-it ABC

r/MIJI OPS It. 713501 JK!„ CO MS0J JKL, CO W&ÍM W3CV.CO WJOjwîCY.CO 7 mm BSTiwc 7mm FGH. CO 7J3WM rrOSA 7/3MM FGH LTD 7/TLÍ1-1 LMV. INC 7fWH FGH. CO JV1A4 FGH LTD PJ1.Í14 MHO S A <V?fl4 OPO. INC JK?fl4 WXY.CO ilrtJM FF G SA fWJM WXY.CQ ftSIM TWGMPII ÍWIÍ14 TWGMilll ascw OPO. INC mm jKL. co ftMM QPQ. INC. ftMM LMN PTt LTD &SC4 DSF, IXC 8/11,04 JKL. CO a/1204 LMN PTT LTD »1304 LMN LTD. 8/1304 RSTINC

10345 tm- 6010

9004 «as 5116

18553 707? ItOTI

HK1 3300 3473

S43G 3300 ffWl

31730 90411 11090

13806 613? 7674

16416 677G 9G4Í1

?1015 9190 11017

31430 9190 13340

31465 9198 13367

6367 354t 3736

9144 «KB 5056

1740 047 093

3401 1073 1379

19110 047Q 1P640

93« 4335 5110

31000 9198 13690

11630 5083 65«

9961 2952 ¿009

3042 984 1058

17505 7623 S692

14440 6776 7664

3552 1684 1958

est iNc

FSH, CO rrosA. ron ltd uTw, ifj; ¿¡PÍA OPÜ. IWC

twgmph I MM prv I.TP nrF.Lic t MM LTD GUI. CO HLJ GMnil hlND CQHP L.ML. HC WMGMEÍH HSTPPil.TP □CO LTP. XYiSA. CPE WC.

XYZÇMBH WfflPTYLTD RST5A LftWINC.

■ Criteria: To filter with criteria, include the parameter CriteriaRange:=Range("L1:L2"). To filter without criteria, omit this optional parameter.

■ Unique: To return only unique records, specify the parameter Unique:=True.

This code sets up a single column output range two columns to the right of the last used column in the data range.

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 will define an object variable for the output range (ORange) and for the input range (iRange):

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

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

1 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) 1 Do the Advanced Filter to get unique list of customers

IRange.AdvancedFilter Action:=xlFilterCopy, CopyToRange:=ORange, Unique:=True End Sub

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

If you run either code on the sample dataset, you will get a unique list of customers off to the right of the data. In Figure 11.4, you will see 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 could easily sort the list and add an array formula to get total revenue by customer. The following code gets the unique list of customers, sorts it, and then builds an array formula to total revenue by customer. The results are shown in Figure 11.5.

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

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 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(65536, NextCol).End(xlUp).Row

' Sort the data

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

' Add an array formula to get totals Cells(1, NextCol + 1).Value = "Revenue" Cells(2, NextCol + 1).FormulaArray = _

"=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 11.5

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

0 0

Post a comment