LinkBack Thread Tools Search this Thread Display Modes
Prev Previous Post   Next Post Next
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 1,560
Default Range Filter Problem when creating new sheets

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!!
 
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
Problem w/Adv Filter criteria range Helen Excel Discussion (Misc queries) 1 April 4th 08 09:14 PM
Problem with creating a named range Alex Excel Programming 11 May 9th 06 03:41 AM
Excel VBA - Range.Replace within workbook over several sheets problem mika Excel Programming 1 July 1st 04 03:01 PM
Problem Creating a Date Range coolroaming Excel Programming 2 April 17th 04 01:59 AM
Problem copying range and pasting to multiple sheets Murphy Excel Programming 1 October 9th 03 07:13 PM


All times are GMT +1. The time now is 04:41 PM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
Copyright ©2004-2025 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"