Advanced Filter, xlFilterCopy and macro help

[n0esc]

Here is a sample of the data I am dealing with

testparkingdata.xls
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S
1	PERMIT#	PERMIT COLOR	OLD PERMIT NUMBER	FIRST NAME	LAST NAME	SUPERVISOR	COLOR	MAKE	MODEL	LICENSE NUMBER	LICENSE PLATE STATE	DATE OF VIOLATION	PARKING VIOLATION CODE	LOT LOCATION	BADGE # (OR INT.)	DATE VOIDED	VOIDED BY	OTHER INFORMATION	KEY COLUMN
2	1000	GREEN	G3258	JOHN	DOE	BOSS DOE	BLACK	GMC	SIERRA 2500	AAA 123	IOWA
3	1001	GREEN	G3351	JOHN	DOE	BOSS DOE	GRAY	JEEP	CHEROKEE	BBB 123	IOWA
4	1002	GREEN	G5656	JANE	DOE	JOHN DOE	GOLD	PONTIAC	GRAND PRIX	CCC 123	WISCONSIN
5	1003	GREEN		JANE	DOE	JOHN DOE	RED	CHEVROLET	SILVERADO	DDD 123	WISCONSIN
6	1005	GREEN	G5929	JAMES	DOE	JANE DOE	BLUE	HONDA	CIVIC	EEE 123	MINNESOTA
7	1006	GREEN	G5819	JAMES	DOE	JANE DOE	BLUE	VOLKSWAGEN	JETTA	FFF 123	MINNESOTA
FULL DATA

I need to be able to use a macro such as the one Norie posts or I located one here: http://www.contextures.com/excelfiles.html but I have been unable to make anything work.

I am using column S for the sorting. Any given cell may or may not be blank depending on missing information, or in the case of L:R if a ticket has never been given.

Rows will also appear multiple times if tickets were issued to that permit number. The only completely unique column will be A.

Ideally the macro would highlight cells on the main sheet if they are sorted to a subsheet, but I am not sure if that is possible. I can't even make it do the basic part that should work fine.

Option Explicit

Sub ExtractReps()
Dim ws1 As Worksheet
Dim wsNew As Worksheet
Dim rng As Range
Dim r As Integer
Dim c As Range
Set ws1 = Sheets("Sheet1")
Set rng = Range("Database")

'extract a list of Sales Reps
ws1.Columns("S:S").Copy _
  Destination:=Range("AL1")
ws1.Columns("AL:AL").AdvancedFilter _
  Action:=xlFilterCopy, _
  CopyToRange:=Range("AJ1"), Unique:=True
r = Cells(Rows.Count, "AJ").End(xlUp).Row

'set up Criteria Area
Range("AL1").Value = Range("S1").Value

For Each c In Range("AJ2:AJ" & r)
  'add the rep name to the criteria area
  ws1.Range("AL2").Value = c.Value
  'add new sheet (if required)
  'and run advanced filter
  If WksExists(c.Value) Then
    Sheets(c.Value).Cells.Clear
    rng.AdvancedFilter Action:=xlFilterCopy, _
        CriteriaRange:=Sheets("Sheet1").Range("AL1:AL2"), _
        CopyToRange:=Sheets(c.Value).Range("A1"), _
        Unique:=False
  Else
    Set wsNew = Sheets.Add
    wsNew.Move After:=Worksheets(Worksheets.Count)
    wsNew.Name = c.Value
    rng.AdvancedFilter Action:=xlFilterCopy, _
        CriteriaRange:=Sheets("Sheet1").Range("AL1:AL2"), _
        CopyToRange:=wsNew.Range("A1"), _
        Unique:=False
  End If
Next
ws1.Select
ws1.Columns("AJ:AL").Delete
End Sub
Function WksExists(wksName As String) As Boolean
    On Error Resume Next
    WksExists = CBool(Len(Worksheets(wksName).Name) > 0)
End Function

If I try to run this, it resets the advanced filter to a much smaller area that matches the example sheet it came with, and only outputs the first 7 column headings, and no data rows. Other times it errors with 1004 mismatch.

Any help would be greatly appreciated. I'm lost, but after manually handling this data for 4 months and 2000 people, I need an easier way before a major mistake happens.[/code]

 

[n0esc]

Anyone... think this kinda got lost in the weekend shuffle.

Thanks in advance.

 

[n0esc]

To the top again... still lost on this.

Anyone?

TIA

 

[n0esc]

Still no help?