Good evening,

I have been racking my brain for the past few weeks off and on trying
to fix some VB code to do what I want it to do. Below, you will see
the VB code I am using. This code was taken from a sample file at an
excel tips website. I have no VB background but I have tweaked this
code to do 90% of what I need it to do. The only thing I can not
figure out is how to get it to select a larger number of rows to bring
into the Advance Filter. The macro will take in only the first 43 rows
of the spreadsheet. If I add more rows to the spreadsheet, it will not
take them into account when the macro runs the Advance Filter.

I have discovered that when I open the file before even running the
macro, the range shows up as A1 through G43 in the Advanced Filter
dialog box via the Data option on the menu bar. Therefore, it may not
be the VB code that is the problem.

Is there some reason why the program is only picking up 43 rows and not
the rest when I add more rows?

The following code is from the sample file located at
http://www.contextures.com/AdvFilterRepFiltered.xls :

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("C:C").Copy _
Destination:=Range("L1")
ws1.Columns("L:L").AdvancedFilter _
Action:=xlFilterCopy, _
CopyToRange:=Range("J1"), Unique:=True
r = Cells(Rows.Count, "J").End(xlUp).Row

'set up Criteria Area
Range("L1").Value = Range("C1").Value

For Each c In Range("J2:J" & r)
'add the rep name to the criteria area
ws1.Range("L2").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("L1:L2"), _
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("L1:L2"), _
CopyToRange:=wsNew.Range("A1"), _
Unique:=False
End If
Next
ws1.Select
ws1.Columns("J:L").Delete
End Sub
Function WksExists(wksName As String) As Boolean
On Error Resume Next
WksExists = CBool(Len(Worksheets(wksName).Name) 0)
End Function




Thank you for any help you can give!!!

Hulk


--
Hulk
------------------------------------------------------------------------
Hulk's Profile: http://www.excelforum.com/member.php...o&userid=14947
View this thread: http://www.excelforum.com/showthread...hreadid=265799