Home |
Search |
Today's Posts |
#1
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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 |
Display Modes | |
|
|
![]() |
||||
Thread | Forum | |||
Problem w/Adv Filter criteria range | Excel Discussion (Misc queries) | |||
Problem with creating a named range | Excel Programming | |||
Excel VBA - Range.Replace within workbook over several sheets problem | Excel Programming | |||
Problem Creating a Date Range | Excel Programming | |||
Problem copying range and pasting to multiple sheets | Excel Programming |