Consulting

Results 1 to 5 of 5

Thread: Advice: Not filtering by given criteria

  1. #1
    VBAX Tutor
    Joined
    Nov 2007
    Posts
    228
    Location

    Question Advice: Not filtering by given criteria

    Hi All,

    I am struggling to get this macro to filter by all of the criteria given.

    I will attach an example worksheet (minus confidential data) and will paste the code I am using.

    Code
    Private Function PTSubtotals(ByRef PTField As PivotField)
    PTField.Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
    End Function
    
    Sub Timesheets()
    ' Timesheets Macro
    ' Timesheet Filter 4/22/2008 by Richard Francis
    Dim myWorkBook As Workbook
    Dim myBaseWorkSheet As Worksheet
    Dim myBaseRange As Range
    Dim myBaseRow As Range
    Dim RowsCounter As Long
    Dim StartDate As Date
    Dim EndDate As Date
    StartDate = Format(Date, "mm/dd/yyyy")
    EndDate = Format(Date, "mm/dd/yyyy")
    On Error Resume Next
    StartDate = Application.InputBox("Enter start date", Type:=2)
    On Error GoTo 0
    If StartDate > 0 Then
        On Error Resume Next
        EndDate = Application.InputBox("Enter end date", Type:=2)
        On Error GoTo 0
        If EndDate > 0 Then
            If EndDate < StartDate Then
                MsgBox "Start date can not be earlier than end date"
            Else
            End If
        End If
    End If
    Application.ScreenUpdating = False
    '// Add required columns and formulas
    Sheets("Timesheet Details").Select
    Range("B1").Select
    ActiveCell.FormulaR1C1 = "Order ID"
    Range("A1:AR1").Select
    With Selection.Interior
        .ColorIndex = 6
        .Pattern = xlSolid
    End With
    Selection.Font.Bold = True
    Selection.AutoFilter
    Range("A1").Select
    Columns("Y:Y").Select
    Selection.Insert Shift:=xlToRight
    Range("Y1").Select
    ActiveCell.FormulaR1C1 = "Timesheet For Week Ending"
    Range("Y2").Select
    ActiveCell.FormulaR1C1 = "=RC[-1]+CHOOSE(WEEKDAY(RC[-1]),0,6,5,4,3,2,1)"
    Range("Y2").Select
    ActiveCell.Offset(0, -1).Range("A1").Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(0, 1).Range("A1").Select
    ActiveCell.FormulaR1C1 = "1"
    Selection.End(xlUp).Select
    Selection.Copy
    Range(Selection, Selection.End(xlDown)).Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    ActiveCell.Select
    Columns("AS:AS").Select
    Selection.Insert Shift:=xlToRight
    Range("AS1").Select
    ActiveCell.FormulaR1C1 = "Approved in Week Ending"
    Range("AS2").Select
    ActiveCell.FormulaR1C1 = "=RC[-1]+CHOOSE(WEEKDAY(RC[-1]),0,6,5,4,3,2,1)"
    Range("AS2").Select
    ActiveCell.Offset(0, -1).Range("A1").Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(0, 1).Range("A1").Select
    ActiveCell.FormulaR1C1 = "1"
    Selection.End(xlUp).Select
    Selection.Copy
    Range(Selection, Selection.End(xlDown)).Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    ActiveCell.Select
    Columns("AT:AT").Select
    Selection.Insert Shift:=xlToRight
    Range("AT1").Select
    ActiveCell.FormulaR1C1 = "Total Amount"
    Range("AT2").Select
    ActiveCell.FormulaR1C1 = "=SUM(RC[-14]*RC[-31])+(RC[-13]*RC[-30])+(RC[-12]*RC[-29])"
    Columns("AT:AT").Select
    Selection.NumberFormat = "_-[$?-809]* #,##0.00_-;-[$?-809]* #,##0.00_-;_-[$?-809]* ""-""??_-;_-@_-"
    Range("AT2").Select
    ActiveCell.Offset(0, -1).Range("A1").Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(0, 1).Range("A1").Select
    ActiveCell.FormulaR1C1 = "1"
    Selection.End(xlUp).Select
    Selection.Copy
    Range(Selection, Selection.End(xlDown)).Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    ActiveCell.Select
    Range("A1").Select
    '// Add Additional Sheets
    Sheets.Add
    Sheets("Sheet1").Select
    Sheets("Sheet1").Name = "Approved Timesheets"
    Sheets.Add
    Sheets("Sheet2").Select
    Sheets("Sheet2").Name = "Approved Timesheets Pivot"
    Sheets.Add
    Sheets("Sheet3").Select
    Sheets("Sheet3").Name = "Pending Timesheets"
    Sheets.Add
    Sheets("Sheet4").Select
    Sheets("Sheet4").Name = "Pending Timesheets Pivot"
    Sheets.Add
    Sheets("Sheet5").Select
    Sheets("Sheet5").Name = "Declined Timesheets"
    Sheets.Add
    Sheets("Sheet6").Select
    Sheets("Sheet6").Name = "Declined Timesheets Pivot"
    '// Copy Data to correct Sheets
    Sheets("Timesheet Details").Select
    Cells.Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Approved Timesheets").Select
    ActiveSheet.Paste
    Sheets("Pending Timesheets").Select
    ActiveSheet.Paste
    Sheets("Declined Timesheets").Select
    ActiveSheet.Paste
    Sheets("Approved Timesheets").Select
    Rows("1:1").Select
    Application.CutCopyMode = False
    Selection.AutoFilter
    Sheets("Pending Timesheets").Select
    Rows("1:1").Select
    Selection.AutoFilter
    Sheets("Declined Timesheets").Select
    Rows("1:1").Select
    Selection.AutoFilter
    Sheets("Timesheet Details").Select
    Range("A1").Select
    '// Delete non required data from each worksheet
    Sheets("Approved Timesheets").Select
    Set myBaseWorkSheet = ActiveWorkbook.ActiveSheet
    Set myBaseRange = myBaseWorkSheet.Rows
    For RowsCounter = myBaseRange.Rows.Count To 2 Step -1
        Set myBaseRow = myBaseRange.Item(RowsCounter)
        If Len(myBaseRow.Cells.Item(1, 8)) <> 0 Then
            If myBaseRow.Cells.Item(1, 21) <> "Approved" Then
                '// Delete data that we do not need for each tab
                If myBaseRow.Cells.Item(1, 44) >= StartDate And myBaseRow.Cells.Item(1, 44) <= EndDate Then
                   myBaseRow.Delete
                End If
            End If
        End If
    Next
    Sheets("Pending Timesheets").Select
    Set myBaseWorkSheet = ActiveWorkbook.ActiveSheet
    Set myBaseRange = myBaseWorkSheet.Rows
    For RowsCounter = myBaseRange.Rows.Count To 2 Step -1
        Set myBaseRow = myBaseRange.Item(RowsCounter)
        If Len(myBaseRow.Cells.Item(1, 8)) <> 0 Then
            '// Delete data that we do not need for each tab
            If myBaseRow.Cells.Item(1, 21) <> "Pending" Then
                myBaseRow.Delete
            End If
        End If
    Next
    Sheets("Declined Timesheets").Select
    Set myBaseWorkSheet = ActiveWorkbook.ActiveSheet
    Set myBaseRange = myBaseWorkSheet.Rows
    For RowsCounter = myBaseRange.Rows.Count To 2 Step -1
        Set myBaseRow = myBaseRange.Item(RowsCounter)
        If Len(myBaseRow.Cells.Item(1, 8)) <> 0 Then
            '// Delete data that we do not need for each tab
            If myBaseRow.Cells.Item(1, 21) <> "Declined" Then
               myBaseRow.Delete
            End If
        End If
    Next
    '// Create Approved Timesheets Pivot
    ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, _
    SourceData:="'Approved Timesheets'!A:AU").CreatePivotTable _
    TableDestination:="'Approved Timesheets Pivot'!R3C1", _
    TableName:="PivotTable1", _
    DefaultVersion:=xlPivotTableVersion10
    Sheets("Approved Timesheets Pivot").Select
    With ActiveSheet.PivotTables("PivotTable1")
        PTSubtotals .PivotFields("Order ID")
        PTSubtotals .PivotFields("Timesheet ID")
        PTSubtotals .PivotFields("X-Ref PO ID")
        PTSubtotals .PivotFields("Cost Center")
        PTSubtotals .PivotFields("Contingent Staff First Name")
        PTSubtotals .PivotFields("Contingent Staff Last Name")
        PTSubtotals .PivotFields("Standard Rate")
        PTSubtotals .PivotFields("Overtime Rate")
        PTSubtotals .PivotFields("Second Overtime Rate")
        PTSubtotals .PivotFields("Regular Hours")
        PTSubtotals .PivotFields("Total Overtime Hours")
        PTSubtotals .PivotFields("Total Second Overtime Hours")
        PTSubtotals .PivotFields("Timesheet For Week Ending")
        PTSubtotals .PivotFields("Total Amount")
        ActiveSheet.PivotTables("PivotTable1").PivotFields("Order ID").PivotItems("(blank)").Visible = False
        .AddFields RowFields:=Array("Order ID", "X-Ref PO ID", "Cost Center", _
        "Contingent Staff First Name", "Contingent Staff Last Name", _
        "Timesheet ID", "Timesheet For Week Ending", "Regular Hours", _
        "Standard Rate", "Total Overtime Hours", "Overtime Rate", _
        "Total Second Overtime Hours", "Second Overtime Rate", "Total Amount")
        .PivotFields("Timesheet ID").Orientation = xlDataField
    End With
    With Sheets("Approved Timesheets Pivot")
        With .Rows("4:4")
            .HorizontalAlignment = xlGeneral
            .VerticalAlignment = xlBottom
            .WrapText = True
            .Orientation = 0
            .AddIndent = False
            .IndentLevel = 0
            .ShrinkToFit = False
            .ReadingOrder = xlContext
            .MergeCells = False
        End With
        .Range("D:D,E:E").ColumnWidth = 9.71
        .Columns("F:F").ColumnWidth = 9.43
        .Range("I:I,K:K,M:M,N:N").NumberFormat = _
        "_-[$?-809]* #,##0.00_-;-[$?-809]* #,##0.00_-;_-[$?-809]* ""-""??_-;_-@_-"
        .Columns("A:A").ColumnWidth = 10.57
        .Columns("B:B").ColumnWidth = 10.57
        .Columns("O:O").Hidden = True
    End With
    ''// Create Pending Timesheets Pivot
    ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, _
    SourceData:="'Pending Timesheets'!A:AU").CreatePivotTable _
    TableDestination:="'Pending Timesheets Pivot'!R3C1", _
    TableName:="PivotTable1", _
    DefaultVersion:=xlPivotTableVersion10
    Sheets("Pending Timesheets Pivot").Select
    With ActiveSheet.PivotTables("PivotTable1")
        PTSubtotals .PivotFields("Order ID")
        PTSubtotals .PivotFields("Timesheet ID")
        PTSubtotals .PivotFields("X-Ref PO ID")
        PTSubtotals .PivotFields("Cost Center")
        PTSubtotals .PivotFields("Contingent Staff First Name")
        PTSubtotals .PivotFields("Contingent Staff Last Name")
        PTSubtotals .PivotFields("Standard Rate")
        PTSubtotals .PivotFields("Overtime Rate")
        PTSubtotals .PivotFields("Second Overtime Rate")
        PTSubtotals .PivotFields("Regular Hours")
        PTSubtotals .PivotFields("Total Overtime Hours")
        PTSubtotals .PivotFields("Total Second Overtime Hours")
        PTSubtotals .PivotFields("Timesheet For Week Ending")
        PTSubtotals .PivotFields("Total Amount")
        ActiveSheet.PivotTables("PivotTable1").PivotFields("Order ID").PivotItems("(blank)").Visible = False
        .AddFields RowFields:=Array("Order ID", "X-Ref PO ID", "Cost Center", _
        "Contingent Staff First Name", "Contingent Staff Last Name", _
        "Timesheet ID", "Timesheet For Week Ending", "Regular Hours", _
        "Standard Rate", "Total Overtime Hours", "Overtime Rate", _
        "Total Second Overtime Hours", "Second Overtime Rate", "Total Amount")
        .PivotFields("Timesheet ID").Orientation = xlDataField
    End With
    With Sheets("Pending Timesheets Pivot")
        With .Rows("4:4")
            .HorizontalAlignment = xlGeneral
            .VerticalAlignment = xlBottom
            .WrapText = True
            .Orientation = 0
            .AddIndent = False
            .IndentLevel = 0
            .ShrinkToFit = False
            .ReadingOrder = xlContext
            .MergeCells = False
        End With
        .Range("D:D,E:E").ColumnWidth = 9.71
        .Columns("F:F").ColumnWidth = 9.43
        .Range("I:I,K:K,M:M,N:N").NumberFormat = _
        "_-[$?-809]* #,##0.00_-;-[$?-809]* #,##0.00_-;_-[$?-809]* ""-""??_-;_-@_-"
        .Columns("A:A").ColumnWidth = 10.57
        .Columns("B:B").ColumnWidth = 10.57
        .Columns("O:O").Hidden = True
    End With
    '// Create Declined Timesheets Pivot
        ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, _
    SourceData:="'Declined Timesheets'!A:AU").CreatePivotTable _
    TableDestination:="'Declined Timesheets Pivot'!R3C1", _
    TableName:="PivotTable1", _
    DefaultVersion:=xlPivotTableVersion10
    Sheets("Declined Timesheets Pivot").Select
    With ActiveSheet.PivotTables("PivotTable1")
        PTSubtotals .PivotFields("Order ID")
        PTSubtotals .PivotFields("Timesheet ID")
        PTSubtotals .PivotFields("X-Ref PO ID")
        PTSubtotals .PivotFields("Cost Center")
        PTSubtotals .PivotFields("Contingent Staff First Name")
        PTSubtotals .PivotFields("Contingent Staff Last Name")
        PTSubtotals .PivotFields("Standard Rate")
        PTSubtotals .PivotFields("Overtime Rate")
        PTSubtotals .PivotFields("Second Overtime Rate")
        PTSubtotals .PivotFields("Regular Hours")
        PTSubtotals .PivotFields("Total Overtime Hours")
        PTSubtotals .PivotFields("Total Second Overtime Hours")
        PTSubtotals .PivotFields("Timesheet For Week Ending")
        PTSubtotals .PivotFields("Total Amount")
        ActiveSheet.PivotTables("PivotTable1").PivotFields("Order ID").PivotItems("(blank)").Visible = False
        .AddFields RowFields:=Array("Order ID", "X-Ref PO ID", "Cost Center", _
        "Contingent Staff First Name", "Contingent Staff Last Name", _
        "Timesheet ID", "Timesheet For Week Ending", "Regular Hours", _
        "Standard Rate", "Total Overtime Hours", "Overtime Rate", _
        "Total Second Overtime Hours", "Second Overtime Rate", "Total Amount")
        .PivotFields("Timesheet ID").Orientation = xlDataField
    End With
    With Sheets("Declined Timesheets Pivot")
         With .Rows("4:4")
            .HorizontalAlignment = xlGeneral
            .VerticalAlignment = xlBottom
            .WrapText = True
            .Orientation = 0
            .AddIndent = False
            .IndentLevel = 0
            .ShrinkToFit = False
            .ReadingOrder = xlContext
            .MergeCells = False
        End With
        .Range("D:D,E:E").ColumnWidth = 9.71
        .Columns("F:F").ColumnWidth = 9.43
        .Range("I:I,K:K,M:M,N:N").NumberFormat = _
        "_-[$?-809]* #,##0.00_-;-[$?-809]* #,##0.00_-;_-[$?-809]* ""-""??_-;_-@_-"
        .Columns("A:A").ColumnWidth = 10.57
        .Columns("B:B").ColumnWidth = 10.57
        .Columns("O:O").Hidden = True
    End With
    Application.ScreenUpdating = True
    End Sub
    The issue is that the Approved Timesheets worksheets contains all approved timesheets and does not filter by the date approved (ref: If myBaseRow.Cells.Item(1, 44) <=Startdate and myBaseRow.Cells.Item(1, 44) >=EndDate Then........

    I enter the start and end date at the start of the process, and it is looking for the corresponding filter date in the correct column, but seems to just ignore this filter entirely.

    Can anyone help please.

    The nice code for the PT's was kindly provided by xld in a previous thread (thankyou) much neater and simpler than my first attempts!!!

    Marshybid

  2. #2
    Distinguished Lord of VBAX VBAX Grand Master Bob Phillips's Avatar
    Joined
    Apr 2005
    Posts
    25,453
    Location
    What's happened, this is back to some days ago, where are all the other changes?
    ____________________________________________
    Nihil simul inventum est et perfectum

    Abusus non tollit usum

    Last night I dreamed of a small consolation enjoyed only by the blind: Nobody knows the trouble I've not seen!
    James Thurber

  3. #3
    VBAX Tutor
    Joined
    Nov 2007
    Posts
    228
    Location
    Hi xld, the other changes consistently select the wrong cells and also as per thread yesterday the approved timesheet worksheet does not contain required header info. I have tried all of your suggestions.

    I have reverted back to parts of the older (original code) the only current issue is that the start and end date info is not being picked up as part of the filter.

    Rather then me keep asking for amendment help on the code you provided (I just couldn't get it to work for me) I felt it was simpler to use the parts of my original code that I know work and edit with the inputbox data

    Marshybid

  4. #4
    Distinguished Lord of VBAX VBAX Grand Master Bob Phillips's Avatar
    Joined
    Apr 2005
    Posts
    25,453
    Location
    OK, but I am out of it then, it worked fine for me as you described, and I am not going back.
    ____________________________________________
    Nihil simul inventum est et perfectum

    Abusus non tollit usum

    Last night I dreamed of a small consolation enjoyed only by the blind: Nobody knows the trouble I've not seen!
    James Thurber

  5. #5
    VBAX Tutor david000's Avatar
    Joined
    Mar 2007
    Location
    Chicago
    Posts
    276
    Location

    Try this link, it has a great example.

    Can anyone help please.
    I can't be any help personally, but this site has a super duper example you can download as a possible solution to your woes.

    Your most likely going to need another column that evaluates the date range to what you (True or False) want then a page field that refeshes that data.

    This example does just that!

    http://www.contextures.com/excelfiles.html#Pivot
    PT0014 - Filter from Worksheet Date Range -- Enter start and end dates on the worksheet, and update the pivot table, to show matching items. PivotDateRange.zip 17kb

    I'm sure this must be close to what your after.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •