Advanced Filter Error - I cannot spot my Error

[JeanPierre Charron]

Sub FilterCrit4()
Dim c As Range
Dim rng As Range
Dim LR As Long
LR = Cells(Rows.Count, "A").End(xlUp).Row
Set rng = Range("A2:S" & LR)
'The following Unique Filter generates an error but I cannot see it
'I had to create my Unique List manually and the rest of the code
' works fine

'Error here --------------------------------------------------------------------
'Range("S2:S" & LR).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("T2"), Unique:=True
'-------------------------------------------------------------------------------

For Each c In Range([T2], Cells(Rows.Count, "T").End(xlUp))
With rng
.AutoFilter
.AutoFilter Field:=19, Criteria1:=c.Value
.SpecialCells(xlCellTypeVisible).Copy
Sheets.Add(After:=Sheets(Sheets.Count)).Name = c.Value
ActiveSheet.Paste
End With
Next c
End Sub

Thank you for your help,
J.P. Charron

 

[Claus Busch]

Hi J.P.,

Am Wed, 5 Nov 2014 10:37:47 -0800 (PST) schrieb JeanPierre Charron:

'Error here --------------------------------------------------------------------
'Range("S2:S" & LR).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("T2"), Unique:=True
'-------------------------------------------------------------------------------

your syntax is correct and for me it is working fine.
Do you have a header in S2? Advanced Filter needs a header or the first
value becomes header.
Can you post an example of your data in column S?


Regards
Claus B.

 

[Claus Busch]

Hi J.P.,

Am Wed, 5 Nov 2014 10:37:47 -0800 (PST) schrieb JeanPierre Charron:

'Error here --------------------------------------------------------------------
'Range("S2:S" & LR).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("T2"), Unique:=True
'-------------------------------------------------------------------------------

if you have headers in row2 you could try:

Sub FilterCrit5()
Dim rng As Range
Dim LR As Long, i As Long
Dim varFilter As Variant, varIn As Variant
Dim myDic As Object

Application.ScreenUpdating = False

LR = Cells(Rows.Count, "A").End(xlUp).Row
Set rng = Range("A2:S" & LR)

Set myDic = CreateObject("Scripting.Dictionary")
varIn = Range("S3:S" & LR)
For i = LBound(varIn) To UBound(varIn)
myDic(varIn(i, 1)) = varIn(i, 1)
Next
varFilter = myDic.items

For i = LBound(varFilter) To UBound(varFilter)
With rng
.AutoFilter Field:=19, Criteria1:=varFilter(i)
.SpecialCells(xlCellTypeVisible).Copy
Sheets.Add(After:=Sheets(Sheets.Count)).Name = varFilter(i)
ActiveSheet.Paste
End With
Next

Application.ScreenUpdating = True
End Sub

If your headers are in row1 then change
Set rng = Range("A2:S" & LR)
to
Set rng = Range("A1:S" & LR)

and
varIn = Range("S3:S" & LR)
to
varIn = Range("S2:S" & LR)


Regards
Claus B.

 

[JeanPierre Charron]

Thank you again, I completely overlooked that requirement of Advanced Filter.
Have a good day,
J.P.