How do I further refine an AdvancedFilter sort?

[dougbert]

Hi!

Excel 2007

The following first section of my code works perfectly. It provides me with a unique list of names from column U on the "Current Prog Accts" worksheet and pastes it formatted the way I wish A-Z on Sheet1. I would like the macro to continue on in section 2 using the same unique names derived from the AdvancedFilter, but add a criteria that the text "AME" must also be in column G for that unique name to still be included and then paste the results to Sheet2. However, I have no idea if I should further refine my criteria using AdvancedFilter, AutoFilter, or ...?

I realize section 2 has pretty much identical code as section1. I just don't know how to make it incorporate the additional level of criteria from column G that I need.

Note: if someone can help me with this 2nd section, I can extrapolate this for two more sheets with "EMEA" and "APJ" as the specific criteria for inclusion on their respective output sheets. Yes, I do need all of this in a single macro.

Sub NamesFilter()
: Rem Section 1 - Display unique names of sponsors on Sheet1
    Sheets("Sheet1").Activate
    Range("A3:A965").ClearContents
    With Sheets("Current Prog Accts").Range("$U$2:$U$965")
        .AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("Sheet1!A3"), Unique:=True
    End With
    Sheets("Sheet1").Select
    Range("A3:A965").Select
    With Range("A2:A965")
        .Borders.LineStyle = xlNone
        .Font.Color = 2
    Selection.Interior.ColorIndex = xlNone
    Application.CutCopyMode = False
    Selection.Sort Key1:=Range("A2:A965"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
    End With

: Rem Section 2 - Display unique names of sponsors only from 'AME' on Sheet2
    Sheets("Sheet2").Activate
    Range("A3:A965").ClearContents
    With Sheets("Current Prog Accts").Range("$U$2:$U$965")
        .AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("Sheet2!A3"), Unique:=True
    End With
    Sheets("Sheet2").Select
    Range("A3:A965").Select
    With Range("A2:A965")
        .Borders.LineStyle = xlNone
        .Font.Color = 2
    Selection.Interior.ColorIndex = xlNone
    Application.CutCopyMode = False
    Selection.Sort Key1:=Range("A2:A965"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
    End With
End Sub

Thanks for any and all replies.
-doug

 

[Datsmart]

This site has some good suggestions using Advanced Filter:
http://www.meadinkent.co.uk/xlfilter.htm

There is code on that site you can adjust for your use.

 

[dougbert]

John,

Thanks for your suggestion. I will use some of the ideas to define my data range on the 'Current Prog Accts' worksheet as it expands in rows.

However, I'm hoping one of the VBA wizards out there can tell me how to simply modify the existing working code I have to just add the additional 'static' criteria to obtain the results I need. I suspect the answer is rather simple.

VBA Wizards unite! I know you know the answer!

-doug

 

[Datsmart]

Did you note the use of "CriteriaRange" in the suggested code on the web site I posted?
Your code is not using this powerful feature of Advanced Filtering. Take a closer look at the web site and particularly the section on "Criteria".

 

[dougbert]

Hi John and ALL,

John: Thanks. Yes. I was aware of CriteriaRange. However, I'm unclear about how to use it to specify criteria located in another column.

So, I decided to strip the code down to just the part that matters and direct the code to the SampleData sheet that follows, and provide a SampleData worksheet, as well as a sample of the desired output result in an effort to make myself better understood.

I have little doubt a VBA guru will happen by soon!

Sub NamesFilter()
Set Sh = Worksheets("SampleData")
Set Sh1 = Worksheets("Sheet1")
Set Sh2 = Worksheets("Sheet2")

With Application
    .EnableEvents = False 'make sure no event macro's are triggered
    .ScreenUpdating = False ' speed up code by turning off screen updating
End With

'Display unique names of sponsors on Sheet1
    Sh.AutoFilterMode = False
    Sh1.Activate
    Range("A3:A1501").ClearContents
    With Sh.Range("$D$2:$D11")
        .AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("Sheet1!A3"), Unique:=True
    End With

'Display unique names of sponsors only from 'AME' on Sheet2
    Sh1.Activate
    Range("A3:A1501").ClearContents
    With Sh.Range("$D$2:$D$11")
        .AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=("What the heck do I put here to specify the text 'AME'?" in column A of SampleData), CopyToRange:=Range("Sheet2!A3"), Unique:=True
    End With
    Sh.Select
Application.EnableEvents = True 'turn event macro's back on
End Sub

Here is the SampleData worksheet:

WW ExecSpon_Revised_3_5_09_df.xlsm
	A	B	C	D	E
1	Region	Stuff	OtherStuff	Sponsor	Units
2	AME	a	1	Smith,John	xx
3	AME	b	2	Johnson,Tim	yy
4	APJ	c	3	Hanson,Fred	zz
5	AME	d	4	Smith,John	aa
6	EMEA	e	5	Anderson,Stan	bb
7	AME	f	6	Davis,Betty	ccc
8	EMEA	g	7	Anderson,Stan	dd
9	APJ	h	8	Davidson,Harley	eeeee
10	AME	i	9	Johnson,Tim	ff
11	APJ	j	10	Hanson,Fred	gggggggg
SampleData

If I could understand how to use CriteriaRange or something else, this would be the output that would appear in A3 on Sheet2 from the SampleData sheet (without the column header, as it is already in place). Cell A3 would contain 'Davis, Betty'.

Sponsor
Davis, Betty
Johnson, Tim
Smith, John

Yes. That's all I need is a unique list of names for the AME region. If someone can help me with this, I should be able to take it from there.

Thanks for all reples!
-doug

 

[Datsmart]

Thank you for showing some sample data.

This code will run Advanced Filter as you are requesting:

Sub FilterToSheet2()
Dim FilterRange As Range, AF_Criteria As Range, TargetRange As Range
'Clear TargetRange of old data
    Sheets("Sheet2").Cells.ClearContents
    'Replace Header name
    Sheets("Sheet2").Range("A2").Value = "Sponsor"
'Set Variables
    Set FilterRange = Sheets("SampleData").Range("A1").CurrentRegion
    Set AF_Criteria = Sheets("SampleData").Range("G1:G2")
    Set TargetRange = Sheets("Sheet2").Range("A2")
'Run Advanced Filter
    FilterRange.AdvancedFilter Action:=xlFilterCopy, _
    CriteriaRange:=AF_Criteria, CopyToRange:=TargetRange, _
        Unique:=True
End Sub

This code assumes your Criteria range is on the SampleData worksheet in Range G1:G2.
G1 would contain "Region" (the header you want to filter on.)
G2 would contain "AME" (The Criteria you want to use.)

If you don't want all columns listed in your TargetRange, you must include the Header names you want to list, if none are included, all columns will be pasted. The code automatically inputs "Sponsor", so that will be the only column listed.

I hope this helps...