Consulting

Results 1 to 17 of 17

Thread: Date Not Filtering Correctly

  1. #1
    VBAX Mentor
    Joined
    Aug 2020
    Location
    Hampshire
    Posts
    395
    Location

    Date Not Filtering Correctly

    I've a very basic macro that performs some very quick tasks such as deleting rows, replacing a few characters and filtering by date, then moving columns across, leaving the cursor in cell A1, selecting the data left and copying it to the clipboard.

    It's the date part that doesn't work 100% or indeed at all.

    What it should do is only leave all data that is eighteen months old or less, with the most recent date at the top and the oldest at the bottom (this is how the data arrives prior to running the macro). I can't even tell you what dates it is selecting. It should be applying the filter based on all cells with a date in the same column (ending up as column 'D'). It almost suggests that it is not applying the date part at all. Any help would be very much appreciated.

    Option Explicit
    Sub Triage()
    '
    ' Triage Macro
    '
        Columns("A:A").Select
        Selection.Delete Shift:=xlToLeft
        Columns("B:B").Select
        Selection.Replace What:=" [O]", Replacement:="", LookAt:=xlPart, _
            SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
            ReplaceFormat:=False
        Columns("D:D").Select
        Selection.NumberFormat = "dd/mm/yyyy;@"
        Columns("E:E").Select
        Selection.Delete Shift:=xlToLeft
        ActiveWindow.SmallScroll ToRight:=-1
        Rows("1:3").Select
        Selection.Delete Shift:=xlUp
        Range("A1").Select
    End Sub

  2. #2
    VBAX Mentor
    Joined
    Aug 2020
    Location
    Hampshire
    Posts
    395
    Location
    Sorry, put the wrong code up and have now managed to sort it!

    Option Explicit
    Sub Triage()
        '
        ' Triage Macro
        ' Perform the basic editing
        Columns("A:A").Select
        Selection.Delete Shift:=xlToLeft
        Columns("B:B").Select
        Selection.Replace What:=" [O]", Replacement:="", LookAt:=xlPart, _
                          SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
                          ReplaceFormat:=False
        Columns("D:D").Select
        Selection.NumberFormat = "dd/mm/yyyy;@"
        Columns("E:E").Select
        Selection.Delete Shift:=xlToLeft
        ActiveWindow.SmallScroll ToRight:=-1
        Rows("1:3").Select
        Selection.Delete Shift:=xlUp
        Range("A1").Select
        
        'Delete all rows with a date older than eighteen months
        Application.ScreenUpdating = False
        ActiveSheet.AutoFilterMode = False
        Dim FilterRange As Range, myDate As Date
        myDate = DateSerial(Year(Date) - 1, Month(Date) - 6, Day(Date))
        Set FilterRange = _
            Range("D8:D" & Cells(Rows.Count, 1).End(xlUp).Row)
        FilterRange.AutoFilter Field:=1, Criteria1:="<" & CDbl(myDate)
        On Error Resume Next
        With FilterRange
            .Offset(1).Resize(.Rows.Count - 1).SpecialCells(12).EntireRow.Delete
        End With
        Err.Clear
        Set FilterRange = Nothing
        ActiveSheet.AutoFilterMode = False
        Application.ScreenUpdating = True
        
        'Select all cells with data in them
        Range("A1").Select
        Range(Selection, Selection.End(xlToRight)).Select
        Range(Selection, Selection.End(xlDown)).Select
        
        'Place selected text into the Clipboard
        Selection.Copy
        
    End Sub

  3. #3
    VBAX Mentor
    Joined
    Aug 2020
    Location
    Hampshire
    Posts
    395
    Location
    Having to open up this thread again as sometimes my code does not work as intended and delete rows that have a date older than eighteen months. It will occasionally leave rows that are older than eighteen months, sometimes by five years or more!

    Is there something wrong with the code or is there perhaps a more efficient and effective method to achieve my aim?

    Thanks!

    ActiveSheet.AutoFilterMode = False
        Dim FilterRange As Range, myDate As Date
        myDate = DateSerial(Year(Date) - 1, Month(Date) - 6, Day(Date))
        Set FilterRange = _
            Range("D8:D" & Cells(Rows.Count, 1).End(xlUp).Row)
        FilterRange.AutoFilter Field:=1, Criteria1:="<" & CDbl(myDate)
        On Error Resume Next
        With FilterRange
            .Offset(1).Resize(.Rows.Count - 1).SpecialCells(12).EntireRow.Delete
        End With
        Err.Clear
        Set FilterRange = Nothing
        ActiveSheet.AutoFilterMode = False

  4. #4
    Moderator VBAX Sage SamT's Avatar
    Joined
    Oct 2006
    Location
    Near Columbia
    Posts
    7,814
    Location
    Function Date_18MonthsAgo() As Date
        Date_18MonthsAgo = DateAdd("m", -18, Date)
    End Function
    Try filtering on "myDate" rather than a number [CDbl(myDate)]
    I expect the student to do their homework and find all the errrors I leeve in.


    Please take the time to read the Forum FAQ

  5. #5
    VBAX Mentor
    Joined
    Aug 2020
    Location
    Hampshire
    Posts
    395
    Location
    Many thanks, Sam!

    Having to put my "wally" head on now.

    Would I add the function as is and then modifiy this line
    FilterRange.AutoFilter Field:=1, Criteria1:="<" & CDbl(myDate)
    to
    FilterRange.AutoFilter Field:=1, Criteria1:="<" & Date_18MonthsAgo
    Thanks!
    Steve

  6. #6
    Knowledge Base Approver VBAX Wizard p45cal's Avatar
    Joined
    Oct 2005
    Location
    Surrey UK
    Posts
    5,844
    Your code in msg#3 is working fine here.
    Attach a worksheet where it's going to fail the way you describe.
    p45cal
    Everyone: If I've helped and you can't be bothered to acknowledge it, I can't be bothered to look at further posts from you.

  7. #7
    Moderator VBAX Sage SamT's Avatar
    Joined
    Oct 2006
    Location
    Near Columbia
    Posts
    7,814
    Location
    Steve,
    That works...If all you do is 18 months prior.

    But maybe you work with different periods
    Function Date_SomeMonthsAgo(NumMonthsPrior as Long) As Date 
    Dim NumPrior As Long
        NumPrior = NumMonthsPrior * -1
        Date_SomeMonthsAgo= DateAdd("m", NumPrior, Date)
    End Function
    Then you can use
    X = Date_SomeMonthsAgo(18)
    'OR
    X = Date_SomeMonthsAgo(3)
    However, if you need to work with very many dates, past and future, I would just use the VBA DateAdd Function as needed.

    About the only time I see a need for a custom Dating UDF is for things like 30/60/90 day payment plans where Business Rules also require the due date be on a workday.
    Last edited by SamT; 05-15-2021 at 08:42 AM.
    I expect the student to do their homework and find all the errrors I leeve in.


    Please take the time to read the Forum FAQ

  8. #8
    VBAX Mentor
    Joined
    Aug 2020
    Location
    Hampshire
    Posts
    395
    Location
    Quote Originally Posted by p45cal View Post
    Your code in msg#3 is working fine here.
    Attach a worksheet where it's going to fail the way you describe.
    I agree that this does work on occasions. Unfortunately by the time I have removed all the sensitive data I will end up with an eleven digit number column and the date column.

  9. #9
    VBAX Mentor
    Joined
    Aug 2020
    Location
    Hampshire
    Posts
    395
    Location
    Quote Originally Posted by SamT View Post
    Steve,
    That works...If all you do is 18 months prior.

    But maybe you work with different periods
    Function Date_SomeMonthsAgo(NumMonthsPrior as Long) As Date 
    Dim NumPrior As Long
        NumPrior = NumMonthsPrior * -1
        Date_SomeMonthsAgo= DateAdd("m", NumPrior, Date)
    End Function
    Then you can use
    X = Date_SomeMonthsAgo(18)
    'OR
    X = Date_SomeMonthsAgo(3)
    However, if you need to work with very many dates, past and future, I would just use the VBA DateAdd Function as needed.

    About the only time I see a need for a custom Dating UDF is for things like 30/60/90 day payment plans where Business Rules also require the due date be on a workday.
    I like the idea of being able to modify for future needs, so have tried incorporating your suggested code.

    I've added as per the following as well as the UDF, but it now ignores all the date filter/delete row function and leaves the entire worksheet as it was including the rows that should have been deleted.

    Dim D As Date
    
    Range("$D:$D").NumberFormat = "dd/mm/yyyy"
    
    D = Date_SomeMonthsAgo(18)
        
        Application.ScreenUpdating = False
        ActiveSheet.AutoFilterMode = False
        Dim FilterRange As Range
        Set FilterRange = _
            Range("D8:D" & Cells(Rows.Count, 1).End(xlUp).Row)
        FilterRange.AutoFilter Field:=1, Criteria1:="<" & D
        On Error Resume Next
        With FilterRange
            .Offset(1).Resize(.Rows.Count - 1).SpecialCells(12).EntireRow.Delete
        End With
        Err.Clear
        Set FilterRange = Nothing
        ActiveSheet.AutoFilterMode = False

  10. #10

  11. #11
    Knowledge Base Approver VBAX Wizard p45cal's Avatar
    Joined
    Oct 2005
    Location
    Surrey UK
    Posts
    5,844
    Just a column of dates will do. Just make sure that it's still 'not working' before attaching here.
    Last edited by p45cal; 05-16-2021 at 04:21 AM.
    p45cal
    Everyone: If I've helped and you can't be bothered to acknowledge it, I can't be bothered to look at further posts from you.

  12. #12
    VBAX Mentor
    Joined
    Aug 2020
    Location
    Hampshire
    Posts
    395
    Location
    Here is a sample spreadsheet with data that failed to locate / remove the lines from 2007. This is a really small sheet as usually there are hundreds on each.

    Many thanks!
    Steve
    Attached Files Attached Files

  13. #13
    Knowledge Base Approver VBAX Wizard
    Joined
    Apr 2012
    Posts
    5,635
    What's the point ?

    Sub M_snb()
       With UsedRange.Columns(4)
            .AutoFilter 1, "<" & DateSerial(2018, 1, 1)
            .Offset(1).SpecialCells(12).ClearContents
            .AutoFilter
        End With
    End Sub

  14. #14
    Moderator VBAX Sage SamT's Avatar
    Joined
    Oct 2006
    Location
    Near Columbia
    Posts
    7,814
    Location
    This is your code with all the extras stripped out. Before running it, make sure that VBA Menu item: Tools >> Options >> General >> "Break on all Errors" is checked.

    After running it, attach a file with Headers and an example row it failed on. Note for us any Errored lines in the code.
    Option Explicit 
    
    Sub RemoveOutDated_BySamT()
    Dim FilterRange As Range
        
        Set FilterRange = ActiveSheet.Range("D9:D" & Cells(Rows.Count, "A").End(xlUp).Row)
        
        With FilterRange
            .AutoFilter Field:=1, Criteria1:="<" & Date_SomeMonthsAgo(18)
            .SpecialCells(xlCellTypeVisible).EntireRow.Delete
        End With
        
        ActiveSheet.AutoFilterMode = False
    End Sub
    
    Function Date_SomeMonthsAgo(NumMonthsPrior As Long) As Date
    Dim NumPrior As Long
        NumPrior = NumMonthsPrior * -1
        Date_SomeMonthsAgo = DateAdd("m", NumPrior, Date)
    End Function
    I expect the student to do their homework and find all the errrors I leeve in.


    Please take the time to read the Forum FAQ

  15. #15
    Knowledge Base Approver VBAX Wizard p45cal's Avatar
    Joined
    Oct 2005
    Location
    Surrey UK
    Posts
    5,844
    The first thing I notice with your file and your code is what happens when:
    Set FilterRange = Range("D8:D" & Cells(Rows.Count, 1).End(xlUp).Row)
    is executed. If I then manually:
    FilterRange.Select
    the selection in this pic is FilterRange:
    2021-05-16_164256.png

    then the following line of code filters:
    2021-05-16_164534.png

    So maybe it's what you're filtering, not the filtering itself, that's the problem?

    In other code you've posted you have the top 3 rows of the sheet being deleted, so maybe you ought to adjust the 8 in
    Set FilterRange = Range("D8:D" & Cells(Rows.Count, 1).End(xlUp).Row)
    perhaps to 1?

    If I do that I get a FlterRange of:
    2021-05-16_165057.png

    which when filtered looks like:
    2021-05-16_165254.png

    and when the rest is run:
    2021-05-16_165438.png

    which looks like the correct dates have been deleted.

    ps. It's the last populated cell in column 1 (column A) that determines the range to filter because of the 1 in :
    Set FilterRange = Range("D8:D" & Cells(Rows.Count, 1).End(xlUp).Row)
    p45cal
    Everyone: If I've helped and you can't be bothered to acknowledge it, I can't be bothered to look at further posts from you.

  16. #16
    VBAX Mentor
    Joined
    Aug 2020
    Location
    Hampshire
    Posts
    395
    Location
    Firstly, a huge thankyou to all for looking into this for me. I've looked at each reply and think that p45cal has found out why the original code wasn't producing the desired results.

    I have to put my hands up and acknowledge that I hadn't explained that the data source would have no headers or blank rows at the top. Sorry for this oversight on my part!

    I think that it was down to the data I was filtering rather than the code as suggested by p45cal and on his advice, I've now altered the Range to D1 and so far, things are looking good!

    Steve

  17. #17
    Knowledge Base Approver VBAX Wizard p45cal's Avatar
    Joined
    Oct 2005
    Location
    Surrey UK
    Posts
    5,844
    Quote Originally Posted by HTSCF Fareha View Post
    the data source would have no headers or blank rows at the top
    Autofilter expects a header row. If you have no header row either that top row will always be deleted or never be deleted depending on the code which deletes. Safest to make sure there is a header row (and it's safer if it's not a blank header).
    p45cal
    Everyone: If I've helped and you can't be bothered to acknowledge it, I can't be bothered to look at further posts from you.

Posting Permissions

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