VBA: Exclude Data Based on Date

[unknownymous]

Hi Guys,

Can you possibly help me of how to code for this scenario:

Basically, I need to exclude the data not older than 4 years. However for the computation, the start date is not based from the current date but I want to set the date so a message box will pop asking me what is the starting date for computation.

[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD]Code[/TD]
[TD]Name[/TD]
[TD]Qty[/TD]
[TD]Date[/TD]
[TD]Source[/TD]
[/TR]
[TR]
[TD]001[/TD]
[TD]Ben[/TD]
[TD]500[/TD]
[TD]05/01/2010[/TD]
[TD]Book 1[/TD]
[/TR]
[TR]
[TD]002[/TD]
[TD]Len[/TD]
[TD]150[/TD]
[TD]05/01/2019[/TD]
[TD]Book 5[/TD]
[/TR]
[TR]
[TD]003[/TD]
[TD]Sean[/TD]
[TD]100[/TD]
[TD]05/01/2018[/TD]
[TD]Book 4[/TD]
[/TR]
[TR]
[TD]004[/TD]
[TD]Roan[/TD]
[TD]350[/TD]
[TD]05/01/2013[/TD]
[TD]Book 1[/TD]
[/TR]
</tbody>[/TABLE]

Result: Exclude Data More than 4 Years

[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD]Code[/TD]
[TD]Name[/TD]
[TD]Qty[/TD]
[TD]Date [/TD]
[TD]Source[/TD]
[/TR]
[TR]
[TD]002[/TD]
[TD]Len[/TD]
[TD]150[/TD]
[TD]05/01/2019[/TD]
[TD]Book 5[/TD]
[/TR]
[TR]
[TD]003[/TD]
[TD]Sean[/TD]
[TD]100[/TD]
[TD]05/01/2018[/TD]
[TD]Book 4[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Excluded[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]001[/TD]
[TD]Ben[/TD]
[TD]500[/TD]
[TD]05/01/2010[/TD]
[TD]Book 1[/TD]
[/TR]
[TR]
[TD]004[/TD]
[TD]Roan[/TD]
[TD]350[/TD]
[TD]05/01/2013[/TD]
[TD]Book 1[/TD]
[/TR]
</tbody>[/TABLE]



****** id="cke_pastebin" style="position: absolute; top: 115.764px; width: 1px; height: 1px; overflow: hidden; left: -1000px;">[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD]Book 1[/TD]
[/TR]
</tbody>[/TABLE]
</body>Any thoughts will be much appreciated.

 

[mumps]

Try:

Sub ExludeDates()
    Application.ScreenUpdating = False
    Dim LastRow As Long, sDate As String
    LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    sDate = InputBox("Please enter a starting date.", "Start Date", Format(Date, "yyyy/mm/dd"))
    If sDate = "" Then Exit Sub
    With Cells(1, 1).CurrentRegion
        .AutoFilter 4, "<" & DateSerial(Year(CDate(sDate)) - 4, Month(CDate(sDate)), Day(CDate(sDate)))
        Cells(Rows.Count, "A").End(xlUp).Offset(2) = "Excluded"
        Range("A2:E" & LastRow).SpecialCells(xlCellTypeVisible).Copy Cells(Rows.Count, "A").End(xlUp).Offset(1)
        Range("A2:E" & LastRow).SpecialCells(xlCellTypeVisible).EntireRow.Delete
        .AutoFilter
    End With
    Application.ScreenUpdating = True
End Sub

 

[unknownymous]

Thanks Mumps!

By the way, can you confirm if in the code "With Cells(1,1) = Row, Column? Still learning with coding.

I did ask as I try the codes where the header is in Row 3 and the date is in 5th column. When I run the macro, the header went missing and found that its in the EXCLUDED SECTION

Excel Sheet:
Row 1 = Title
Row 2 = Data Description
Row3 = HEADERS
Row 4 = DATA STARTS and so on


Can you help to modify the codes?


Thank you!

 

[mumps]

Try:

Sub ExludeDates()
    Application.ScreenUpdating = False
    Dim LastRow As Long, sDate As String
    LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    sDate = InputBox("Please enter a starting date.", "Start Date", Format(Date, "yyyy/mm/dd"))
    If sDate = "" Then Exit Sub
    With Cells(1, 1).CurrentRegion
        .AutoFilter 4, "<" & DateSerial(Year(CDate(sDate)) - 4, Month(CDate(sDate)), Day(CDate(sDate)))
        Cells(Rows.Count, "A").End(xlUp).Offset(2) = "Excluded"
        Range("A4:E" & LastRow).SpecialCells(xlCellTypeVisible).Copy Cells(Rows.Count, "A").End(xlUp).Offset(1)
        Range("A4:E" & LastRow).SpecialCells(xlCellTypeVisible).EntireRow.Delete
        .AutoFilter
    End With
    Application.ScreenUpdating = True
End Sub

"Cells(1,1)" is the same as "Range("A1"). Either one can be used.

 

[unknownymous]

This is great! Thank you mumps!

 

[mumps]

You are very welcome.