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.

Code	Name	Qty	Date	Source
001	Ben	500	05/01/2010	Book 1
002	Len	150	05/01/2019	Book 5
003	Sean	100	05/01/2018	Book 4
004	Roan	350	05/01/2013	Book 1

<tbody>
</tbody>

Result: Exclude Data More than 4 Years

Code	Name	Qty	Date	Source
002	Len	150	05/01/2019	Book 5
003	Sean	100	05/01/2018	Book 4
Excluded
001	Ben	500	05/01/2010	Book 1
004	Roan	350	05/01/2013	Book 1

<tbody>
</tbody>

****** id="cke_pastebin" style="position: absolute; top: 115.764px; width: 1px; height: 1px; overflow: hidden; left: -1000px;">

Book 1

<tbody>
</tbody>

</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.