Thread: AdvancedFilter
View Single Post
  #3   Report Post  
Posted to microsoft.public.excel.programming
dannibrook dannibrook is offline
external usenet poster
 
Posts: 3
Default AdvancedFilter

Bob, thank-you that works fine. How could I change the following more
generic code to do similar. The filter criteria is first picked up from the
line

ThisCust = cell.Value

I then need to adapt this in the following code so that the contents of
ThisCust are as you specified

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


"Bob Phillips" wrote:

Change

Cells(2, NextCol).Value = "D"

to

Cells(2, NextCol).FormulaR1C1 = "=""=D"""

--
HTH

Bob Phillips

(remove nothere from email address if mailing direct)

"dannibrook" wrote in message
...
Using the following code AdvancedFilter is working except where the filter

is
set to 'D' on a particular column the returned set contains all rows where
that column starts with a 'D' i.e. D, Dad, Dolphin .... I need the

returned
to be limited to the rows where column contains exactly 'D'.

Sub AllColumnsOneCustomer()
' Page 227
Dim IRange As Range
Dim ORange As Range
Dim CRange As Range

' Since this is called from a button on Menu,
' first select the sample data sheet
Worksheets("DBSize").Select
' Clear out results of previous macros
Range("G1:M50").EntireColumn.Delete

' 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
' In reality, this value should be passed from the userform
Cells(2, NextCol).Value = "D"
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
' Range("L1").Select

End Sub