Help with CriteriaRange in VBA .AdvancedFilter Method. ( calling in the Cavalry !! )

DocAElstein

DocAElstein

Banned user
Joined
May 24, 2014
Messages
1,336
. Hi senior “Colleagues”!,
.
. One way I am learning my Excel / VBA is by answering Threads here.
. I answered one with both a Formula and a VBA Code. The code was much too complicated As I was not yet familiar enough with the method I expect is the best, the VBA Advanced Filter Method. Particularly I do not have the experience yet in getting the correct CriteriaRange

. can someone help?

. So, a simplified example.. I start with this.

Using Excel 2007
[Table="width:, class:grid"][tr][td]-[/td][td]
A​
[/td][td]
B​
[/td][td]
C​
[/td][td]
D​
[/td][td]
E​
[/td][td]
F​
[/td][/tr]
[tr][td]
1​
[/td][td]Code[/td][td]Date[/td][td]startdate[/td][td]stopdate[/td][td][/td][td][/td][/tr]

[tr][td]
2​
[/td][td]
3104​
[/td][td]4/18/2015[/td][td]4/21/2015[/td][td]4/25/2015[/td][td][/td][td][/td][/tr]

[tr][td]
3​
[/td][td]
3599​
[/td][td]4/23/2015[/td][td][/td][td][/td][td][/td][td][/td][/tr]

[tr][td]
4​
[/td][td]
4004​
[/td][td]4/15/2015[/td][td][/td][td][/td][td][/td][td][/td][/tr]

[tr][td]
5​
[/td][td]
7158​
[/td][td]4/25/2015[/td][td][/td][td][/td][td][/td][td][/td][/tr]

[tr][td]
6​
[/td][td]
7158​
[/td][td]4/23/2015[/td][td][/td][td][/td][td][/td][td][/td][/tr]

[tr][td]
7​
[/td][td]
7158​
[/td][td]4/23/2015[/td][td][/td][td][/td][td][/td][td][/td][/tr]

[tr][td]
8​
[/td][td][/td][td][/td][td][/td][td][/td][td][/td][td][/td][/tr]
[/table][Table="width:, class:grid"][tr][td]JL DataAdvFilt[/td][/tr][/table]

……………
. And wot I finally want is this.

Using Excel 2007
[Table="width:, class:grid"][tr][td]-[/td][td]
A​
[/td][td]
B​
[/td][td]
C​
[/td][td]
D​
[/td][td]
E​
[/td][td]
F​
[/td][/tr]
[tr][td]
1​
[/td][td]Code[/td][td]Date[/td][td]startdate[/td][td]stopdate[/td][td][/td][td]Code[/td][/tr]

[tr][td]
2​
[/td][td]
3104​
[/td][td]4/18/2015[/td][td]4/21/2015[/td][td]4/25/2015[/td][td][/td][td]3599[/td][/tr]

[tr][td]
3​
[/td][td]
3599​
[/td][td]4/23/2015[/td][td][/td][td][/td][td][/td][td]7158[/td][/tr]

[tr][td]
4​
[/td][td]
4004​
[/td][td]4/15/2015[/td][td][/td][td][/td][td][/td][td][/td][/tr]

[tr][td]
5​
[/td][td]
7158​
[/td][td]4/25/2015[/td][td][/td][td][/td][td][/td][td][/td][/tr]

[tr][td]
6​
[/td][td]
7158​
[/td][td]4/23/2015[/td][td][/td][td][/td][td][/td][td][/td][/tr]

[tr][td]
7​
[/td][td]
7158​
[/td][td]4/23/2015[/td][td][/td][td][/td][td][/td][td][/td][/tr]
[/table][Table="width:, class:grid"][tr][td]JL DataAdvFilt[/td][/tr][/table]

.

. Putting it into words.

. I want to list out the Unique Codes Numbers from Column A, but only if the corresponding date or dates for any of any these Code Numbers ( given in the corresponding row in Column B ) lie within the start and stop date criteria given in cells C2 and D2 respectively.

. I have one possible start point in the code I give a the end. There, in line 70, the Advanced Filter is run first without any CriteriaRange, with unique argument set to true,
Unique:=True
. … this gives me a column of the unique Code numbers which I place arbitrarily starting in cell C10.

. I expect the next step would be to complete the missing bit in my argument for the critical Range,
CriteriaRange:=Range("C10:________,
. …. To run the Advanced Filter a second time In my line 90.
. In addition I would need the appropriate combination of headings, and or not headings in a the critical range which has cell C10 as its Top left corner. Also I need the exact format / syntax that I put in a few rows starting at row 10 and being within the specified Critical Range.

. Possibly some other Critical Range could do away with my code line 70 ?

…………………………………………..

. I have a non AdvancedFilterMethod VBA code, and I would like a VBA AdvancedFilterMethod version. But of course if anyone “feels the urge to do some other VBA Code or a better formula then me then please do so here or in that Thread
http://www.mrexcel.com/forum/excel-...ique-values-depending-date-adjacent-cell.html

. Any response here which I use I will, of course, a-credit the worthy!!

Many Thanks
. Alan
……………………………………

Here my start attempt at the Advanced Filter Method VBA code

Code: 
[color=blue]Sub[/color] AdvancedFilterMethod()
10 [color=blue]Dim[/color] wks1 [color=blue]As[/color] Worksheet: [color=blue]Set[/color] wks1 = ThisWorkbook.Worksheets("JL data") [color=lightgreen]'[/color]
20
30 [color=blue]Dim[/color] lastrow [color=blue]As[/color] Long: [color=blue]Let[/color] lastrow = wks1.Cells(Rows.Count, "A").End(xlUp).Row
40 [color=lightgreen]'[/color]
50 [color=blue]Dim[/color] rngCode [color=blue]As[/color] Range: [color=blue]Set[/color] rng = wks1.Range("A1:A" & lastrow & "")
60 [color=lightgreen]'AdvancedFilter Run 1 to get Unique Codes for critical range in Run 2[/color]
70 rngCode.AdvancedFilter Action:=xlFilterCopy, CopyToRange:=wks1.Range("C10"), Unique:=[color=blue]True[/color]
80 [color=lightgreen]'AdvancedFilter Run 2[/color]
90 rngCode.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range("C10:________, CopyToRange:=wks1.Range("F2")
 
 
[color=blue]End[/color] [color=blue]Sub[/color] [color=lightgreen]'AdvancedFilterMethod()[/color]


In case it helps, particularly as getting the correct critical range criteria across in a screenshot can be tricky I enclose the File I am playing with just now , should you have the time to view, and possible put a solution in for me.. I will paste appropriate screen shots so everyone can follow anything you do..
https://app.box.com/s/kffotse2fsqoifavx2w3whpra6w4jjqd
 
Sort by date Sort by votes
RoryA said:
There is nothing to reset. I'm pretty sure the dates in your example are stored as text - you need to convert them to proper dates to get anything to work reliably.
Click to expand...



Hi Rory,
. Appreciate your continued response. But Sounds like a non solvable mystery here. Or there is some other issue that have overlooked. I do have other codes working, just a shame as on the face of it the .AdvancedFilter method “appeared” the neatest. I guess with things like .AutoFilter , .AdvancedFilter they look neat, but when they go wrong you cannot “step through” and see where it goes wrong as everything is in a “neat” one line..

. My last attempt just now, I changed also the dates in the Data Range also using your formula format.

Formulas

Using Excel 2007
[Table="width:, class:grid"][tr][td]-[/td][td]
A​
[/td][td]
B​
[/td][td]
C​
[/td][td]
D​
[/td][/tr]
[tr][td]
1​
[/td][td]Code[/td][td]Date[/td][td]startdate[/td][td]stopdate[/td][/tr]

[tr][td]
2​
[/td][td]
3104​
[/td][td]="="&DATE(2015,4,18)[/td][td]4/21/2015[/td][td]4/25/2015[/td][/tr]

[tr][td]
3​
[/td][td]
3599​
[/td][td]="="&DATE(2015,4,23)[/td][td][/td][td][/td][/tr]

[tr][td]
4​
[/td][td]
4004​
[/td][td]="="&DATE(2015,4,15)[/td][td][/td][td][/td][/tr]

[tr][td]
5​
[/td][td]
7158​
[/td][td]="="&DATE(2015,4,25)[/td][td][/td][td][/td][/tr]

[tr][td]
6​
[/td][td]
7158​
[/td][td]="="&DATE(2015,4,23)[/td][td][/td][td][/td][/tr]

[tr][td]
7​
[/td][td]
7158​
[/td][td]="="&DATE(2015,4,23)[/td][td][/td][td][/td][/tr]

[tr][td]
8​
[/td][td][/td][td][/td][td]Date[/td][td]Date[/td][/tr]

[tr][td]
9​
[/td][td][/td][td][/td][td]=">="&DATE(2015,4,21)[/td][td]="<="&DATE(2015,4,25)[/td][/tr]

[tr][td]
10​
[/td][td][/td][td][/td][td][/td][td][/td][/tr]
[/table][Table="width:, class:grid"][tr][td]NewSheet4[/td][/tr][/table]

Value:

Using Excel 2007
[Table="width:, class:grid"][tr][td]-[/td][td]
A​
[/td][td]
B​
[/td][td]
C​
[/td][td]
D​
[/td][/tr]
[tr][td]
1​
[/td][td]Code[/td][td]Date[/td][td]startdate[/td][td]stopdate[/td][/tr]

[tr][td]
2​
[/td][td]
3104​
[/td][td]=42112[/td][td]4/21/2015[/td][td]4/25/2015[/td][/tr]

[tr][td]
3​
[/td][td]
3599​
[/td][td]=42117[/td][td][/td][td][/td][/tr]

[tr][td]
4​
[/td][td]
4004​
[/td][td]=42109[/td][td][/td][td][/td][/tr]

[tr][td]
5​
[/td][td]
7158​
[/td][td]=42119[/td][td][/td][td][/td][/tr]

[tr][td]
6​
[/td][td]
7158​
[/td][td]=42117[/td][td][/td][td][/td][/tr]

[tr][td]
7​
[/td][td]
7158​
[/td][td]=42117[/td][td][/td][td][/td][/tr]

[tr][td]
8​
[/td][td][/td][td][/td][td]Date[/td][td]Date[/td][/tr]

[tr][td]
9​
[/td][td][/td][td][/td][td]>=42115[/td][td]<=42119[/td][/tr]

[tr][td]
10​
[/td][td][/td][td][/td][td][/td][td][/td][/tr]
[/table][Table="width:, class:grid"][tr][td]NewSheet4[/td][/tr][/table]


... results identical. – Starting with a new sheet, my first rngCode.AdvancedFilter part works initially , the rngCodeDate.AdvancedFilter does not. After the first run, my rngCode.AdvancedFilter no, longer works. Sometimes my rngCode.AdvancedFilter will then work if I delete the new criteria Range("C8:D9")

Thanks again
Alan

P.s.1 “Silly question” , sorry, just wanted to check that I did not miss something obvious again ::?

You meant
=">="&DATE(2015,4,21)
="<="&DATE(2015,4,25)

P.s.2 I have updated my file link
https://app.box.com/s/kffotse2fsqoifavx2w3whpra6w4jjqd
If anyone has the time to take a look. I am up to “NewSheet4” now. Various code attempts and screen formats are there ( Codes I usually put in the appropriate sheet module )



Current code

Code: 
[color=blue]Sub[/color] AdvancedFilterMethodRory()
10 [color=blue]Dim[/color] wks1 [color=blue]As[/color] Worksheet: [color=blue]Set[/color] wks1 = ThisWorkbook.Worksheets("NewSheet4") [color=lightgreen]'[/color]
20
30 [color=blue]Dim[/color] lastrow [color=blue]As[/color] Long: [color=blue]Let[/color] lastrow = wks1.Cells(Rows.Count, "A").End(xlUp).Row
40 [color=lightgreen]'[/color]
50 'AdvancedFilter Run 1 to get a Unique Codes Column
60 [color=blue]Dim[/color] rngCode [color=blue]As[/color] Range: [color=blue]Set[/color] rngCode = wks1.Range("A1:A" & lastrow & "")
70 rngCode.AdvancedFilter Action:=xlFilterCopy, CopyToRange:=wks1.Range("C10"), Unique:=[color=blue]True[/color]
80 [color=lightgreen]'AdvancedFilter Run Rory2[/color]
82 [color=blue]Dim[/color] rngCodeDate [color=blue]As[/color] Range: [color=blue]Set[/color] rngCodeDate = wks1.Range("A1:B" & lastrow & "")
84 rngCodeDate.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=wks1.Range("C8:D9"), CopyToRange:=wks1.Range("D10") [color=lightgreen]', Unique:=True[/color]
 
[color=lightgreen]'90 rngCode.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range("C10:________, CopyToRange:=wks1.Range("F2")[/color]
 
[color=blue]End[/color] [color=blue]Sub[/color] [color=lightgreen]'AdvancedFilterMethodRory()[/color]
 
Upvote 0

Excel Facts

Do you hate GETPIVOTDATA?
Prevent GETPIVOTDATA. Select inside a PivotTable. In the Analyze tab of the ribbon, open the dropown next to Options and turn it off
Hi Rory,

. well, interesting..

. That does appear to make the rngCodeDate.AdvancedFilter “work”. Clearly .AdvancedFilter is a lot more sensitive to date formats than VBA!!
.
. But the problem of the “weird not working after one run is still there”.

. Spreadsheet as with the latest format, ( your Post ) #12

Code
Code: 
[color=blue]Option[/color] [color=blue]Explicit[/color]
 
[color=blue]Sub[/color] AdvancedFilterMethodRory()
10 [color=blue]Dim[/color] wks1 [color=blue]As[/color] Worksheet: [color=blue]Set[/color] wks1 = ThisWorkbook.Worksheets("NewSheet6") [color=lightgreen]'[/color]
20
30 [color=blue]Dim[/color] lastrow [color=blue]As[/color] Long: [color=blue]Let[/color] lastrow = wks1.Cells(Rows.Count, "A").End(xlUp).Row
40 [color=lightgreen]'[/color]
50 'AdvancedFilter Run 1 to get a Unique Codes Column
60 [color=blue]Dim[/color] rngCode [color=blue]As[/color] Range: [color=blue]Set[/color] rngCode = wks1.Range("A1:A" & lastrow & "")
70 rngCode.AdvancedFilter Action:=xlFilterCopy, CopyToRange:=wks1.Range("C10"), Unique:=[color=blue]True[/color]
80 [color=lightgreen]'AdvancedFilter Run Rory2[/color]
82 [color=blue]Dim[/color] rngCodeDate [color=blue]As[/color] Range: [color=blue]Set[/color] rngCodeDate = wks1.Range("A1:B" & lastrow & "")
84 rngCodeDate.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=wks1.Range("C8:D9"), CopyToRange:=wks1.Range("D10") [color=lightgreen]', Unique:=True[/color]
 
[color=lightgreen]'90 rngCode.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range("C10:________, CopyToRange:=wks1.Range("F2")[/color]
 
[color=blue]End[/color] [color=blue]Sub[/color] [color=lightgreen]'AdvancedFilterMethodRory()[/color]

. First run in new sheet
.

Using Excel 2007
[Table="width:, class:grid"][tr][td]-[/td][td]
A​
[/td][td]
B​
[/td][td]
C​
[/td][td]
D​
[/td][td]
E​
[/td][/tr]
[tr][td]
1​
[/td][td]Code[/td][td]Date[/td][td]startdate[/td][td]stopdate[/td][td][/td][/tr]

[tr][td]
2​
[/td][td]
3104​
[/td][td]
42112​
[/td][td]4/21/2015[/td][td]4/25/2015[/td][td][/td][/tr]

[tr][td]
3​
[/td][td]
3599​
[/td][td]
42117​
[/td][td][/td][td][/td][td][/td][/tr]

[tr][td]
4​
[/td][td]
4004​
[/td][td]
42109​
[/td][td][/td][td][/td][td][/td][/tr]

[tr][td]
5​
[/td][td]
7158​
[/td][td]
42119​
[/td][td][/td][td][/td][td][/td][/tr]

[tr][td]
6​
[/td][td]
7158​
[/td][td]
42117​
[/td][td][/td][td][/td][td][/td][/tr]

[tr][td]
7​
[/td][td]
7158​
[/td][td]
42117​
[/td][td][/td][td][/td][td][/td][/tr]

[tr][td]
8​
[/td][td][/td][td][/td][td]Date[/td][td]Date[/td][td][/td][/tr]

[tr][td]
9​
[/td][td][/td][td][/td][td]>=42115[/td][td]<=42119[/td][td][/td][/tr]

[tr][td]
10​
[/td][td][/td][td][/td][td]Code[/td][td]Code[/td][td]Date[/td][/tr]

[tr][td]
11​
[/td][td][/td][td][/td][td]
3104​
[/td][td]
3599​
[/td][td]
42117​
[/td][/tr]

[tr][td]
12​
[/td][td][/td][td][/td][td]
3599​
[/td][td]
7158​
[/td][td]
42119​
[/td][/tr]

[tr][td]
13​
[/td][td][/td][td][/td][td]
4004​
[/td][td]
7158​
[/td][td]
42117​
[/td][/tr]

[tr][td]
14​
[/td][td][/td][td][/td][td]
7158​
[/td][td]
7158​
[/td][td]
42117​
[/td][/tr]

[tr][td]
15​
[/td][td][/td][td][/td][td][/td][td][/td][td][/td][/tr]
[/table][Table="width:, class:grid"][tr][td]NewSheet6[/td][/tr][/table]

......

. then clear Range C10 to E14, original start conditions....

Results of second run...

Using Excel 2007
[Table="width:, class:grid"][tr][td]-[/td][td]
A​
[/td][td]
B​
[/td][td]
C​
[/td][td]
D​
[/td][td]
E​
[/td][/tr]
[tr][td]
1​
[/td][td]Code[/td][td]Date[/td][td]startdate[/td][td]stopdate[/td][td][/td][/tr]

[tr][td]
2​
[/td][td]
3104​
[/td][td]
42112​
[/td][td]4/21/2015[/td][td]4/25/2015[/td][td][/td][/tr]

[tr][td]
3​
[/td][td]
3599​
[/td][td]
42117​
[/td][td][/td][td][/td][td][/td][/tr]

[tr][td]
4​
[/td][td]
4004​
[/td][td]
42109​
[/td][td][/td][td][/td][td][/td][/tr]

[tr][td]
5​
[/td][td]
7158​
[/td][td]
42119​
[/td][td][/td][td][/td][td][/td][/tr]

[tr][td]
6​
[/td][td]
7158​
[/td][td]
42117​
[/td][td][/td][td][/td][td][/td][/tr]

[tr][td]
7​
[/td][td]
7158​
[/td][td]
42117​
[/td][td][/td][td][/td][td][/td][/tr]

[tr][td]
8​
[/td][td][/td][td][/td][td]Date[/td][td]Date[/td][td][/td][/tr]

[tr][td]
9​
[/td][td][/td][td][/td][td]>=42115[/td][td]<=42119[/td][td][/td][/tr]

[tr][td]
10​
[/td][td][/td][td][/td][td]Code[/td][td]Code[/td][td]Date[/td][/tr]

[tr][td]
11​
[/td][td][/td][td][/td][td][/td][td]
3599​
[/td][td]
42117​
[/td][/tr]

[tr][td]
12​
[/td][td][/td][td][/td][td][/td][td]
7158​
[/td][td]
42119​
[/td][/tr]

[tr][td]
13​
[/td][td][/td][td][/td][td][/td][td]
7158​
[/td][td]
42117​
[/td][/tr]

[tr][td]
14​
[/td][td][/td][td][/td][td][/td][td]
7158​
[/td][td]
42117​
[/td][/tr]
[/table][Table="width:, class:grid"][tr][td]NewSheet6[/td][/tr][/table]

......

Weird. The final result actually required by the OP was

Using Excel 2007
[Table="width:, class:grid"]
[tr][td]Code[/td][/tr]

[tr][td]
3599​
[/td][/tr]

[tr][td]
7158​
[/td][/tr]

[tr][td][/td][/tr]
[/table][Table="width:, class:grid"][tr][td]Newsheet2[/td][/tr][/table]

. I will not probably get there consistently as I need to run the code twice to get at those unique codes that lie within the date.. And If I did, I would be apprehensive to use the code, as clearly there are some weird things going on here...
. However, As I appear to get the date criteria now ( thanks Rory you have got me to this point ), I shall look to see if I can somehow take it further ... Maybe the rngCode.AdvancedFilter without a critical range is what goes wrong: Perhaps once any code is run in a sheet a default ( the last ) critical range is stored and used. That could explain it. But again that would require some resetting of the sheet..

.. Hmm.....
 
Upvote 0
There is no need to filter twice. Put the header for the output column(s) you want in the destination range top row, then use advanced filter with the date criteria and specify Unique:=True.

It seems you are correct about the criteria range not being reset. That seems like a bug to me, but I will have to check if it's a known issue.
 
Upvote 0
RoryA said:
There is no need to filter twice. Put the header for the output column(s) you want in the destination range top row, then use advanced filter with the date criteria and specify Unique:=True.......
Click to expand...


.. that would not work in this case as the OP wants just unique codes, your suggestion returns
Using Excel 2007
[Table="width:, class:grid"]
[tr][td]
3599​
[/td][/tr]

[tr][td]
7158​
[/td][/tr]

[tr][td]
7158​
[/td][/tr]
[/table][Table="width:, class:grid"][tr][td]NewSheet6[/td][/tr][/table]

.. but that is a very minor point ... the actual OP criteria got lost along the way

... The main thing! –

. Got there – as always with you!!

... and I got to do an On Error handler. ( I know I should'nt...).. ;)

. Codes below does the business! ( first using .AdvancedFilter twice, - second time with no criteria Range and therefore spreadsheet “memory” of “criteria” , second using .AdvancedFilter first then .RemoveDuplicates to remove duplicates – just as i had done that in the meantime! )



. I expect the effort will be lost on the OP as the extra formatting of dates would probably not be worth the effort, and the extra sensibility puts me off this Method.. , but the Thread has brought out some very good points. Maybe it should be (re) titled VBA .Advanced Filter method only works once with no criteria Range ( sometimes... )
Thanks again Rory..

Alan


..... Start Point for both Codes:

Using Excel 2007
[Table="width:, class:grid"][tr][td]-[/td][td]
A​
[/td][td]
B​
[/td][td]
C​
[/td][td]
D​
[/td][/tr]
[tr][td]
1​
[/td][td]Code[/td][td]Date[/td][td]startdate[/td][td]stopdate[/td][/tr]

[tr][td]
2​
[/td][td]
3104​
[/td][td]
42112​
[/td][td]4/21/2015[/td][td]4/25/2015[/td][/tr]

[tr][td]
3​
[/td][td]
3599​
[/td][td]
42117​
[/td][td][/td][td][/td][/tr]

[tr][td]
4​
[/td][td]
4004​
[/td][td]
42109​
[/td][td][/td][td][/td][/tr]

[tr][td]
5​
[/td][td]
7158​
[/td][td]
42119​
[/td][td][/td][td][/td][/tr]

[tr][td]
6​
[/td][td]
7158​
[/td][td]
42117​
[/td][td][/td][td][/td][/tr]

[tr][td]
7​
[/td][td]
7158​
[/td][td]
42117​
[/td][td][/td][td][/td][/tr]

[tr][td]
8​
[/td][td][/td][td][/td][td]Date[/td][td]Date[/td][/tr]

[tr][td]
9​
[/td][td][/td][td][/td][td]>=42115[/td][td]<=42119[/td][/tr]
[/table][Table="width:, class:grid"][tr][td]NewSheet9[/td][/tr][/table]

....

Codes: ( Run ‘em as many times as you like !! )

Code: 
[color=blue]Sub[/color] AdvancedFilterMethodRorySussedIt()
10 [color=blue]Dim[/color] wks1 [color=blue]As[/color] Worksheet: [color=blue]Set[/color] wks1 = ThisWorkbook.Worksheets("NewSheet9") [color=lightgreen]'[/color]
20 [color=blue]Dim[/color] lastrow [color=blue]As[/color] Long: [color=blue]Let[/color] lastrow = wks1.Cells(Rows.Count, "A").End(xlUp).Row
 
30 [color=lightgreen]'AdvancedFilter Run Rory Filter by Date Range[/color]
40 [color=blue]Dim[/color] rngCodeDate [color=blue]As[/color] Range: [color=blue]Set[/color] rngCodeDate = wks1.Range("A1:B" & lastrow & "")
50 rngCodeDate.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=wks1.Range("C8:D9"), CopyToRange:=wks1.Range("D10") [color=lightgreen]', Unique:=True[/color]
 
60 [color=lightgreen]'Clearing The Advanced Filter Dialog Box[/color]
70 [color=blue]On[/color] [color=blue]Error[/color] [color=blue]Resume[/color] [color=blue]Next[/color]
[color=lightgreen]'80 wks1.Names("_FilterDatabase").Delete[/color]
90 wks1.Names("Criteria").Delete
[color=lightgreen]'100 wks1.Names("Extract").Delete[/color]
110 [color=blue]On[/color] [color=blue]Error[/color] [color=blue]GoTo[/color] 0
120 [color=lightgreen]'AdvancedFilter Run 1 to get a Unique Codes Column[/color]
130 [color=blue]Dim[/color] lastFilteredRow [color=blue]As[/color] Long: [color=blue]Let[/color] lastFilteredRow = wks1.Cells(Rows.Count, "D").End(xlUp).Row
140 [color=blue]Dim[/color] rngFilteredCodes [color=blue]As[/color] Range: [color=blue]Set[/color] rngFilteredCodes = wks1.Range("D10:D" & lastFilteredRow & "")
150 rngFilteredCodes.AdvancedFilter Action:=xlFilterCopy, CopyToRange:=wks1.Range("F1"), Unique:=[color=blue]True[/color]
[color=blue]End[/color] [color=blue]Sub[/color] [color=lightgreen]'AdvancedFilterMethodRorySussed()[/color]
 
[color=blue]Sub[/color] AdvancedFilterMethodAndRemoveDuplicates()
10 [color=blue]Dim[/color] wks1 [color=blue]As[/color] Worksheet: [color=blue]Set[/color] wks1 = ThisWorkbook.Worksheets("NewSheet9") [color=lightgreen]'[/color]
20 [color=blue]Dim[/color] lastrow [color=blue]As[/color] Long: [color=blue]Let[/color] lastrow = wks1.Cells(Rows.Count, "A").End(xlUp).Row
30 [color=lightgreen]'Clearing The Advanced Filter Dialog Box[/color]
32 [color=blue]On[/color] [color=blue]Error[/color] [color=blue]Resume[/color] [color=blue]Next[/color] [color=lightgreen]'. On Error Resume Next instructing to carry on following the line just after where the error occurred, also it prevents an exception being raised. In effect On Error Resume Next results in things going on as if no error occurred. This is because with no raised exception VBA “knows” of no error...so....[/color]
[color=lightgreen]'34 wks1.Names("_FilterDatabase").Delete[/color]
36 wks1.Names("Criteria").Delete
[color=lightgreen]'38 wks1.Names("Extract").Delete[/color]
40 [color=blue]On[/color] [color=blue]Error[/color] [color=blue]GoTo[/color] 0 [color=lightgreen]'....( For this reason I can disable it regardless of what happened in the program by enabling a different error handler ( or using the error statement On Error Goto 0 )[/color]
[color=lightgreen]'[/color]
50 'AdvancedFilter Run 1 to get a Unique Codes Column: THIS WILL ONLY WORK ONCE IN Fresh sheet if lines 80 - 82 are then run!!
60 [color=blue]Dim[/color] rngCode [color=blue]As[/color] Range: [color=blue]Set[/color] rngCode = wks1.Range("A1:A" & lastrow & "")
70 rngCode.AdvancedFilter Action:=xlFilterCopy, CopyToRange:=wks1.Range("C10"), Unique:=[color=blue]True[/color]
[color=lightgreen]'[/color]
80 'AdvancedFilter Run Rory2 Filter by Date Range
82 [color=blue]Dim[/color] rngCodeDate [color=blue]As[/color] Range: [color=blue]Set[/color] rngCodeDate = wks1.Range("A1:B" & lastrow & "")
84 rngCodeDate.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=wks1.Range("C8:D9"), CopyToRange:=wks1.Range("D10") [color=lightgreen]', Unique:=True[/color]
86 [color=lightgreen]'[/color]
90 ' Remove Duplicate Codes in Filtered CodeDate Range
100 [color=blue]Dim[/color] lastFilteredRow [color=blue]As[/color] Long: [color=blue]Let[/color] lastFilteredRow = wks1.Cells(Rows.Count, "D").End(xlUp).Row
102 [color=blue]Dim[/color] rngFilteredCodes [color=blue]As[/color] Range: [color=blue]Set[/color] rngFilteredCodes = wks1.Range("D10:D" & lastFilteredRow & "")
104 rngFilteredCodes.RemoveDuplicates Columns:=1, Header:=xlYes
[color=blue]End[/color] [color=blue]Sub[/color] [color=lightgreen]'AdvancedFilterMethodAndRemoveDuplicates()[/color]



Results from First code

Using Excel 2007
[Table="width:, class:grid"][tr][td]-[/td][td]
A​
[/td][td]
B​
[/td][td]
C​
[/td][td]
D​
[/td][td]
E​
[/td][td]
F​
[/td][/tr]
[tr][td]
1​
[/td][td]Code[/td][td]Date[/td][td]startdate[/td][td]stopdate[/td][td][/td][td]Code[/td][/tr]

[tr][td]
2​
[/td][td]
3104​
[/td][td]
42112​
[/td][td]4/21/2015[/td][td]4/25/2015[/td][td][/td][td]
3599​
[/td][/tr]

[tr][td]
3​
[/td][td]
3599​
[/td][td]
42117​
[/td][td][/td][td][/td][td][/td][td]
7158​
[/td][/tr]

[tr][td]
4​
[/td][td]
4004​
[/td][td]
42109​
[/td][td][/td][td][/td][td][/td][td][/td][/tr]

[tr][td]
5​
[/td][td]
7158​
[/td][td]
42119​
[/td][td][/td][td][/td][td][/td][td][/td][/tr]

[tr][td]
6​
[/td][td]
7158​
[/td][td]
42117​
[/td][td][/td][td][/td][td][/td][td][/td][/tr]

[tr][td]
7​
[/td][td]
7158​
[/td][td]
42117​
[/td][td][/td][td][/td][td][/td][td][/td][/tr]

[tr][td]
8​
[/td][td][/td][td][/td][td]Date[/td][td]Date[/td][td][/td][td][/td][/tr]

[tr][td]
9​
[/td][td][/td][td][/td][td]>=42115[/td][td]<=42119[/td][td][/td][td][/td][/tr]

[tr][td]
10​
[/td][td][/td][td][/td][td][/td][td]Code[/td][td]Date[/td][td][/td][/tr]

[tr][td]
11​
[/td][td][/td][td][/td][td][/td][td]
3599​
[/td][td]
42117​
[/td][td][/td][/tr]

[tr][td]
12​
[/td][td][/td][td][/td][td][/td][td]
7158​
[/td][td]
42119​
[/td][td][/td][/tr]

[tr][td]
13​
[/td][td][/td][td][/td][td][/td][td]
7158​
[/td][td]
42117​
[/td][td][/td][/tr]

[tr][td]
14​
[/td][td][/td][td][/td][td][/td][td]
7158​
[/td][td]
42117​
[/td][td][/td][/tr]

[tr][td]
15​
[/td][td][/td][td][/td][td][/td][td][/td][td][/td][td][/td][/tr]
[/table][Table="width:, class:grid"][tr][td]NewSheet9[/td][/tr][/table]


Results from second code:

Using Excel 2007
[Table="width:, class:grid"][tr][td]-[/td][td]
A​
[/td][td]
B​
[/td][td]
C​
[/td][td]
D​
[/td][td]
E​
[/td][/tr]
[tr][td]
1​
[/td][td]Code[/td][td]Date[/td][td]startdate[/td][td]stopdate[/td][td][/td][/tr]

[tr][td]
2​
[/td][td]
3104​
[/td][td]
42112​
[/td][td]4/21/2015[/td][td]4/25/2015[/td][td][/td][/tr]

[tr][td]
3​
[/td][td]
3599​
[/td][td]
42117​
[/td][td][/td][td][/td][td][/td][/tr]

[tr][td]
4​
[/td][td]
4004​
[/td][td]
42109​
[/td][td][/td][td][/td][td][/td][/tr]

[tr][td]
5​
[/td][td]
7158​
[/td][td]
42119​
[/td][td][/td][td][/td][td][/td][/tr]

[tr][td]
6​
[/td][td]
7158​
[/td][td]
42117​
[/td][td][/td][td][/td][td][/td][/tr]

[tr][td]
7​
[/td][td]
7158​
[/td][td]
42117​
[/td][td][/td][td][/td][td][/td][/tr]

[tr][td]
8​
[/td][td][/td][td][/td][td]Date[/td][td]Date[/td][td][/td][/tr]

[tr][td]
9​
[/td][td][/td][td][/td][td]>=42115[/td][td]<=42119[/td][td][/td][/tr]

[tr][td]
10​
[/td][td][/td][td][/td][td]Code[/td][td]Code[/td][td]Date[/td][/tr]

[tr][td]
11​
[/td][td][/td][td][/td][td]
3104​
[/td][td]
3599​
[/td][td]
42117​
[/td][/tr]

[tr][td]
12​
[/td][td][/td][td][/td][td]
3599​
[/td][td]
7158​
[/td][td]
42119​
[/td][/tr]

[tr][td]
13​
[/td][td][/td][td][/td][td]
4004​
[/td][td][/td][td]
42117​
[/td][/tr]

[tr][td]
14​
[/td][td][/td][td][/td][td]
7158​
[/td][td][/td][td]
42117​
[/td][/tr]
[/table][Table="width:, class:grid"][tr][td]NewSheet9[/td][/tr][/table]


.................................................................................
 
Upvote 0
hiker95 said:
DocAElstein,
Have you tried my macro solution?
Click to expand...
DocAElstein said:
Hi Hiker,
. Hope the fishing went well..
Of course, as always - Brilliant Hiker…..got tied up in the .Advanced Filter problem.
….. but hope to give you some interesting feedback later
. …….
Alan
Click to expand...

Hiker,
. Such a nice idea, simple, but great! The best ideas always are..!
. - you check the date range criteria , then do the unique key getting bit with the Microsoft Runtime Scripting.Dictionary, making the final output values the unique keys. All in one go. Very neat.
. More to programming than programming I guess. A well thought out logic.
.
. I am posting a modified version of your code just now in the following Thread,
http://www.mrexcel.com/forum/excel-...ique-values-depending-date-adjacent-cell.html
.
. Thanks again for enriching a Thread with an alternative solution. I really love the Threads were many variations are given
. Thanks again.

Alan

P.s. a couple of minor points Observations...

. 1 ) This step puzzeled me
Code: 
o = Application.Transpose(Array(.Keys))
. – it appears to work exactly the same as
Code: 
o = Application.Transpose(.Keys)
. - have I missed something in your thinking?

. 2 ) I expect you may know this, I just wanted to mention in passing just in case, as I noticed it recently and use it myself now in codes of this type utilising the Microsoft Runtime Scripting.Dictionary to obtain unique keys.
. – I use the following now
Code: 
Dim z As Variant


z= .Item( x )
method.
It does away with checking for existence of, and then assigning a key ( and item )
. Normally this method puts the Item value with the key x in the variable z. However, as a by product it creates that unique key ( x ) should it not exist, ( and puts “” or empty in the variable z )

Your code version utilising this would be the following. ( I tested it - it works ). Sorry if i am insulting your intelligence if you have long since learnt this, but as you say yourself there is just so much to learn it is possible you may not of encountered it

Your code using z= .item ( x) Method

Code: 
[color=blue]Sub[/color] ExtractUniqueCodesBetweenDatesdotitems()
[color=lightgreen]' hiker95, 05/31/2015, ME857793[/color]
[color=blue]Dim[/color] rng [color=blue]As[/color] Range, c [color=blue]As[/color] Range, o [color=blue]As[/color] [color=blue]Variant[/color], z [color=blue]As[/color] [color=blue]Variant[/color]
[color=blue]With[/color] Sheets("JL DataAdvFilt")   [color=lightgreen]'<-- you can change the sheet name here[/color]
  [color=blue]Set[/color] rng = .Range("B2:B" & .Range("B" & .Rows.Count).End(xlUp).Row)
  [color=blue]With[/color] CreateObject("Scripting.Dictionary")
    [color=blue]For[/color] [color=blue]Each[/color] c [color=blue]In[/color] rng
      [color=blue]If[/color] c.Value >= [C2] And c.Value <= [D2] [color=blue]Then[/color]
        [color=lightgreen]'If Not .Exists(c.Offset(, -1).Value) Then[/color]
        z = .Item(c.Offset(, -1).Value) [color=lightgreen]''You will not see anything here in z : Post #7   http://www.excelforum.com/excel-programming-vba-macros/1083899-copy-and-paste-entire-row-to-second-sheet-based-on-cell-value.html[/color]
        [color=lightgreen]'  .Add c.Offset(, -1).Value, c.Offset(, -1).Value[/color]
        [color=lightgreen]'End If[/color]
      [color=blue]End[/color] [color=blue]If[/color]
    [color=blue]Next[/color] c
    o = Application.Transpose(Array(.Keys))
  [color=blue]End[/color] [color=blue]With[/color]
  .Columns(6).ClearContents
  .Cells(1, 6) = "Code"
  .Cells(2, 6).Resize(UBound(o, 1), UBound(o, 2)) = o
  .Columns(6).AutoFit
[color=blue]End[/color] [color=blue]With[/color]
End [color=blue]Sub[/color]
 
Upvote 0
DocAElstein,

Fishing, and, spending quality time with my son was great.

Thanks for the feedback.

You are very welcome. Glad I could help.

And, come back anytime.
 
Upvote 0
You must log in or register to reply here.

Similar threads

Z
  • Solved
VBA: Advanced Filter Limitations
Replies
3
Views
833
zero269
Z
T
  • Question Question
Multiple filters on filtered list
Replies
1
Views
612
Cubist
Cubist
R
  • Question Question
Advanced Filter Macro works until I run a different Advanced Filter Macro in same workbook
Replies
1
Views
438
rdarrylhudson
R
S
  • Question Question
Help with VBA AdvancedFilter
Replies
3
Views
433
sidel801
S
A
  • Question Question
Advanced Filter Macro with subtotal?
Replies
0
Views
311
Add564656
A

Forum statistics

Threads
1,224,828
Messages
6,181,217
Members
453,024
Latest member
Wingit77

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top