Consulting

Results 1 to 20 of 20

Thread: Solved: Resolved: Delete row after 3 months

  1. #1

    Solved: Resolved: Delete row after 3 months

    Lets say I have a date in column I. Is there a way to automatically delete the row after 3 months when the worksheet is opened or changed?

    So if the date in column I is 1/1/2008 then on 4/1/2008 the row with that date would automatically delete. I would need this to go through every row which could be a few hundred rows long.

    Anybody have any ideas on how to do this?

    Thanks
    Last edited by bonesmcgraw; 03-15-2008 at 06:41 PM.

  2. #2
    VBAX Tutor
    Joined
    Jan 2008
    Posts
    266
    Location
    i think you could use the date variable to do that.

    [vba]

    if Date - Range(cell).value > 90 then
    Selection.EntireRow.Delete
    end if

    [/vba]

    and make that as a makro to search the cells

    but we need to know more information about your sheet, where is the date for example?
    could you upload a dummy sheet that looks the same?

  3. #3
    VBAX Mentor tstav's Avatar
    Joined
    Feb 2008
    Location
    Athens
    Posts
    350
    Location
    Quote Originally Posted by bonesmcgraw
    automatically delete the row after 3 months when the worksheet is opened or changed
    Put this code in the Worksheet's Module:

    [vba]Private Sub Worksheet_Activate()
    Dim lastRow As Long, curRow As Long
    lastRow = Range("I" & Rows.Count).End(xlUp).Row
    For curRow = lastRow To 1 Step -1
    If DateDiff("m", Range("I" & curRow).Value, Date) = 3 And _
    Day(Date) = Day(Range("I" & curRow).Value) Then
    Rows(curRow).Delete
    End If
    Next
    End Sub

    Private Sub Worksheet_Change(ByVal Target As Range)
    Dim lastRow As Long, curRow As Long
    lastRow = Range("I" & Rows.Count).End(xlUp).Row
    For curRow = lastRow To 1 Step -1
    If DateDiff("m", Range("I" & curRow).Value, Date) = 3 And _
    Day(Date) = Day(Range("I" & curRow).Value) Then
    Rows(curRow).Delete
    End If
    Next
    End Sub
    [/vba]

    But if you meant 3 days and not 3 months, change the "DateDiff" line of code to:
    [vba]If DateDiff("d", Range("I" & curRow).Value, Date) = 3 Then[/vba]
    He didn't know it was impossible, so he did it. (Jean Cocteau)

  4. #4
    Distinguished Lord of VBAX VBAX Grand Master Bob Phillips's Avatar
    Joined
    Apr 2005
    Posts
    25,446
    Location
    Problem with Datediff is that it counts months inclusively, so 12th Jan to 1st April counts as 3, but by my reckoning 3 months are not yet up.
    ____________________________________________
    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 Mentor tstav's Avatar
    Joined
    Feb 2008
    Location
    Athens
    Posts
    350
    Location
    That's why I included the additional check with the Day() function.
    He didn't know it was impossible, so he did it. (Jean Cocteau)

  6. #6
    Distinguished Lord of VBAX VBAX Grand Master Bob Phillips's Avatar
    Joined
    Apr 2005
    Posts
    25,446
    Location
    But you don't need to

    [vba]

    With Range("I" & curRow)

    If DateSerial(Year(.Value), Month(.Value) + 3, Day(.Value)) <= Date Then
    Rows(curRow).Delete
    End If
    End With
    [/vba]
    ____________________________________________
    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

  7. #7
    VBAX Mentor tstav's Avatar
    Joined
    Feb 2008
    Location
    Athens
    Posts
    350
    Location
    The problem would be with Nov. 30th.
    There is no Feb.30, so Nov.30 would never be deleted.
    In that case I might use
    [vba]If DateDiff("m", Range("I" & curRow).Value, Date) > 3 Or _
    (DateDiff("m", Range("I" & curRow).Value, Date) = 3 And _
    Day(Date) = Day(Range("I" & curRow).Value)) Then [/vba]
    He didn't know it was impossible, so he did it. (Jean Cocteau)

  8. #8
    Distinguished Lord of VBAX VBAX Grand Master Bob Phillips's Avatar
    Joined
    Apr 2005
    Posts
    25,446
    Location
    But it would get tidied up on 1st March (or any time after) because of the <= test.

    And of course, your code won't tidy up any old ones that may get missed over weekends say.
    ____________________________________________
    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

  9. #9
    VBAX Mentor tstav's Avatar
    Joined
    Feb 2008
    Location
    Athens
    Posts
    350
    Location
    I sent post #7 before seeing #6.
    Yes. DateSerial is a much better choice indeed!
    He didn't know it was impossible, so he did it. (Jean Cocteau)

  10. #10
    Distinguished Lord of VBAX VBAX Grand Master Bob Phillips's Avatar
    Joined
    Apr 2005
    Posts
    25,446
    Location
    Not much better, just an alternative. I have been burnt by Datediff, so I tend to avoid it. As you point out, there is a flaw in just adding months when the month being added to has more days than the month target and the date is at the end of that month. Then you just manage it according to the requirement, for instance this will return 1st March when adding 3 to 30th Nov as you know

    [vba]

    Dim mpDate As Date

    mpDate = DateSerial(2007, 11, 30)

    MsgBox DateSerial(Year(mpDate), Month(mpDate) + 3, Day(mpDate))
    [/vba]

    whereas this will return 29th Feb

    [vba]

    Dim mpDate As Date

    mpDate = DateSerial(2007, 11, 30)

    MsgBox Format(ActiveSheet.Evaluate("MIN(DATE(YEAR(" & CLng(mpDate) & ")," & _
    "MONTH(" & CLng(mpDate) & ")+{4,3}," & _
    "DAY(" & CLng(mpDate) & ")*{0,1}))"), "dd mmm yyyy")
    [/vba]
    ____________________________________________
    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

  11. #11
    VBAX Tutor
    Joined
    Jan 2008
    Posts
    262
    Location
    The question we should ask is whether it needs to be 3 months or is 90 days just as good. As was said, months weren't all created equal! Perhaps we could be thinking much more simplistically about this problem.

  12. #12
    VBAX Mentor tstav's Avatar
    Joined
    Feb 2008
    Location
    Athens
    Posts
    350
    Location
    .
    He didn't know it was impossible, so he did it. (Jean Cocteau)

  13. #13
    VBAX Mentor tstav's Avatar
    Joined
    Feb 2008
    Location
    Athens
    Posts
    350
    Location
    Here are some dates and what you get if you move forward
    -3 months with DateSerial, or
    -90 days simply by adding days.

    Doesn't the DateSerial column depict better what we commonly mean when we say "3 months later"?

    DateSerial (+3 months) (+90 days)
    01/02/2007 01/05/2007 02/05/2007 (?)
    30/01/2007 30/04/2007 30/04/2007
    01/02/2007 01/05/2007 02/05/2007 (?)
    28/02/2007 28/05/2007 29/05/2007 (?)
    01/05/2007 01/08/2007 30/07/2007 (?)
    30/05/2007 30/08/2007 28/08/2007 (???)
    31/05/2007 31/08/2007 29/08/2007 (???)
    01/11/2007 01/02/2008 30/01/2008 (?)
    29/11/2007 29/02/2008 27/02/2008 (?)
    30/11/2007 01/03/2008 28/02/2008 (???)
    Last edited by tstav; 03-15-2008 at 05:32 AM.
    He didn't know it was impossible, so he did it. (Jean Cocteau)

  14. #14
    VBAX Tutor
    Joined
    Jan 2008
    Posts
    262
    Location
    I agree it is good at giving a better representation of what we mean by "in three months time" but programmatically 90 days is easier and it may be of no difference to the person using it whether it was 90 days, 93 days or "3 months"

  15. #15
    Distinguished Lord of VBAX VBAX Grand Master Bob Phillips's Avatar
    Joined
    Apr 2005
    Posts
    25,446
    Location
    IMO, 90 days is the worst option. There is no 3 month span in a year that is 90 day, the best you can do is 91, and in that can still be 2 days out. So that level of inaccuracy is not even worth considering as other solutions are realtively simple to code.
    ____________________________________________
    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

  16. #16
    Thanks for all the help.

    This is the code that I used and it's giving me an error.

    [VBA]Private Sub Worksheet_Activate()
    Dim lastRow As Long, curRow As Long
    lastRow = Range("I" & Rows.Count).End(xlUp).Row
    For curRow = lastRow To 1 Step -1
    With Range("I" & curRow)

    If DateSerial(Year(.Value), Month(.Value) + 3, Day(.Value)) <= Date Then
    Rows(curRow).Delete
    End If
    End With
    Next
    End Sub

    Private Sub Worksheet_Change(ByVal Target As Range)
    Dim lastRow As Long, curRow As Long
    lastRow = Range("I" & Rows.Count).End(xlUp).Row
    For curRow = lastRow To 1 Step -1
    With Range("I" & curRow)

    If DateSerial(Year(.Value), Month(.Value) + 3, Day(.Value)) <= Date Then
    Rows(curRow).Delete
    End If
    End With
    Next
    End Sub
    [/VBA]

    The code deletes the correct rows but it gives me a run time error 13 type mismatch. Then I click the debug button and it highlights this line

    [VBA]If DateSerial(Year(.Value), Month(.Value) + 3, Day(.Value)) <= Date Then[/VBA]

    Any ideas on how to fix this?

    Thanks

  17. #17
    VBAX Expert
    Joined
    Feb 2005
    Location
    Nanaimo, British Columbia, Cananda
    Posts
    568
    Location
    Hi bones,

    I can't recreate your error but... Everytime a row is deleted by these subs the sub fires again recursively. So you need to disable events temporarily as follows. May cure the problem...


    [vba]
    Option Explicit
    Private Sub Worksheet_Change(ByVal Target As Range)
    Dim curRow As Long
    Dim lastRow As Long

    'Handle any errors
    On Error GoTo endo

    'Disable events so this sub doesn't run for EVERY deleted row
    Application.EnableEvents = False

    lastRow = Range("I" & Rows.Count).End(xlUp).Row

    For curRow = lastRow To 1 Step -1
    With Range("I" & curRow)
    If DateSerial(Year(.Value), Month(.Value) + 3, Day(.Value)) <= Date Then
    Rows(curRow).Delete
    End If
    End With
    Next

    'Error label
    endo:

    'reset
    Application.EnableEvents = True

    End Sub
    [/vba]
    Cheers,

    dr

    "Questions, help and advice for free, small projects by donation. large projects by quote"

    http:\\www.ExcelVBA.joellerabu.com

  18. #18
    Thanks for the help it seems to be working.

  19. #19
    VBAX Mentor tstav's Avatar
    Joined
    Feb 2008
    Location
    Athens
    Posts
    350
    Location
    I guess it encountered a cell that it cannot convert to a date in order for the DateSerial to work.
    We will use Error Handling for this.
    Apart from that we will also take care of possible blank cells and events from recurring

    Change the code to this:
    [vba]Private Sub Worksheet_Activate()
    Dim lastRow As Long, curRow As Long
    Application.EnableEvents = False
    lastRow = Range("I" & Rows.Count).End(xlUp).Row
    On Error Resume Next
    For curRow = lastRow To 1 Step -1
    With Range("I" & curRow)
    If IsDate(.Value) And _
    DateSerial(Year(.Value), Month(.Value) + 3, Day(.Value)) <= Date Then
    If Err Then
    Err.Clear
    Else
    Rows(curRow).Delete
    End If
    End If
    End With
    Next
    Application.EnableEvents = True
    End Sub

    Private Sub Worksheet_Change(ByVal Target As Range)
    Dim lastRow As Long, curRow As Long
    Application.EnableEvents = False
    lastRow = Range("I" & Rows.Count).End(xlUp).Row
    On Error Resume Next
    For curRow = lastRow To 1 Step -1
    With Range("I" & curRow)
    If IsDate(.Value) And _
    DateSerial(Year(.Value), Month(.Value) + 3, Day(.Value)) <= Date Then
    If Err Then
    Err.Clear
    Else
    Rows(curRow).Delete
    End If
    End If
    End With
    Next
    Application.EnableEvents = True
    End Sub
    [/vba]

    hmmm... rbrhodes already caught the events recurring thing...
    He didn't know it was impossible, so he did it. (Jean Cocteau)

  20. #20
    VBAX Mentor tstav's Avatar
    Joined
    Feb 2008
    Location
    Athens
    Posts
    350
    Location
    The error handling in post #17 will stop the code from running possibly leaving rows unchecked for deletion.
    This will not happen with code #19.
    He didn't know it was impossible, so he did it. (Jean Cocteau)

Posting Permissions

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