Sorting data based on dates

[FatalLordes]

Hi all

I have a huge amount of data (8000+ rows) that includes a start date. What I would love to do is only show data where the start date is between 7 days prior to today's date and 28 days past today's date (so effectively a 5 week period). Obviously the date of today will change depending on when run. Below is sample of my data. How would I go about doing this in VBA please? I have formatted the two date fields to dd/m/yyyy hh:mm, if that makes a difference.

Thanks in advance

 

[FatalLordes]

I figure first step is working out the dates, so I've done this:

Dim nowDateTime As Date, pastDateTime As Date, fwdDateTime As Date
nowDateTime = Now
pastDateTime = nowDateTime - 4
fwdDateTime = nowDateTime + 28

But now I have to figure out how to go through every row and see if the start date falls in between (and including) pastDateTime and fwdDateTime. If it does fall between, then keep the row. If it doesn't, delete the row.

 

[FatalLordes]

So I did the following, which works, but I figure there is probably a cleaner more efficient way of doing it. If there is, please share so I can learn

' Delete Rows if Col E is before pastDateTime
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim i As Long
For i = Range("E" & Rows.Count).End(xlUp).Row To 1 Step -1
If Not (Range("E" & i).Value >= pastDateTime) Then
Range("E" & i).EntireRow.Delete
End If
Next i
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True


' Delete Rows if Col E is past fwdDateTime
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim ii As Long
For ii = Range("E" & Rows.Count).End(xlUp).Row To 1 Step -1
If Not (Range("E" & ii).Value <= fwdDateTime) Then
Range("E" & ii).EntireRow.Delete
End If
Next ii
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

 

[kevin9999]

Please try the following:

Option Explicit
Sub FiveWeeksData()
    Dim ws As Worksheet
    Set ws = Worksheets("Sheet1")       '<-- *** Change to actual sheet name ****
    If ws.AutoFilterMode Then ws.AutoFilter.ShowAllData
    With ws.Range("A1").CurrentRegion
        .AutoFilter 5, ">=" & CLng(Date - 7), 1, "<=" & CLng(Date + 28)
    End With
End Sub

 

[kevin9999]

Just in case you do want to actually delete the dates not falling within the desired range (I can only assume the data is refreshed in its entirety at some point?) here is that option:

Option Explicit
Sub FiveWeeksData_V2()
    Dim ws As Worksheet
    Set ws = Worksheets("Sheet1")       '<-- *** Change to actual sheet name ****
    If ws.AutoFilterMode Then ws.AutoFilter.ShowAllData
    With ws.Range("A1").CurrentRegion
        .AutoFilter 5, "<=" & CLng(Date - 7), 2, ">=" & CLng(Date + 28)
        If .SpecialCells(xlCellTypeVisible).Address <> .Rows(1).Address Then
            .Offset(1).EntireRow.Delete
        Else
            MsgBox "No dates found to delete"
        End If
        .AutoFilter
    End With
End Sub

 

[FatalLordes]

Thanks. I'll have a look see at your work so I can learn how you did that and what it is doing

 

[kevin9999]

Thank you, I look forward to your feedback.