Range Filter Problem when creating new sheets

D

David

I've taken two worksheets from Deb's Contextures site (wow, what a resource!)
and am having a problem when trying to combine code from two of them.
I have a worksheet where I can set a date range to filter rows by date. That
works fine.
I can then create new worksheets by the names of the people in Column C.
That works fine.
The problem is when I have the filer on for the date...when creating the new
sheets, the filter is turned off and all dates are included.
I've put a display flag in Cell B4 of the "All_Jobs" page so that if the
filter is on, it displays Y, if off, N.
What I need is for the code that creates the sheets to look a this flag, and
if Y, then only include the dates within the filter, if N, it can use all the
dates. I just don't know how to make it do it.

Here is the pertinent extract code (I think):

Option Explicit
Sub ExtractReps()
Dim ws1 As Worksheet
Dim wsNew As Worksheet
Dim rng As Range
Dim r As Integer
Dim c As Range
Dim wCtr As Long

Worksheets("sheet1").Visible = xlSheetVisible
Sheets("sheet1").Activate

Set ws1 = Sheets("Sheet1")
'Set ws1 = Sheets("Sheet1")
Set rng = Range("DatabaseAll")
'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
End Sub

Here is the code to Apply The Filter:

Option Explicit
Sub ApplyFilter()
Dim wsDL As Worksheet
Dim wsO As Worksheet
Dim rngAD As Range
Set wsDL = Sheets("DateList")
Set wsO = Sheets("All_Jobs")
Set rngAD = wsO.Range("AllDates")
'update the list of dates
wsDL.Range("A1").CurrentRegion.ClearContents
'rngAD.Offset(-1, 0).Resize(rngAD.Rows.Count + 1).Select
rngAD.AdvancedFilter _
Action:=xlFilterCopy, CriteriaRange:="", _
CopyToRange:=wsDL.Range("A1"), Unique:=True
wsDL.Range("A1").CurrentRegion.Sort _
Key1:=wsDL.Range("A2"), Order1:=xlAscending, Header:=xlYes
'filter the list
wsO.Range("Database").AdvancedFilter _
Action:=xlFilterInPlace, _
CriteriaRange:=wsO.Range("H1:I2"), Unique:=False
Range("B4") = "Y"
End Sub
Sub RemoveFilter()
On Error Resume Next
ActiveSheet.ShowAllData
Range("B4") = "N"
End Sub

Thanks for any help with this!!
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top