VBA to execute filter for future date ranges

[ShaneFalco]

Hello All,

I am very new to the VBA world and am just starting to get my feet wet. The first project i want to under take is for VBA to filter out certain ranges in my table. The ranges i need are between =TODAY()+335 and =TODAY()+365, between =TODAY()+700 and =TODAY()+735 and between =TODAY()+1065 and =TODAY()+1095. Or at least that is how I am able to accomplish this in basic Excel. I basically want to look at all of my products that have an expiration date 1, 2 and 3 years from the past month.

I have piecemailed some code together but obviously i am on the wrong path as when i run it for the 1 year mark it just filters out my entire spreadsheet and i see nothing when i should see 40-50 lines

here is the code

Public Sub ExpirationDateFilter()
Dim lo As ListObject
   Dim iCol As Long
   Set lo = Sheet1.ListObjects(1)
   iCol = lo.ListColumns("Expiration").Index
   lo.AutoFilter.ShowAllData
   With lo.Range
        .AutoFilter Field:=iCol, _
        Criteria1:=">= today()+335", _
        Operator:=xlOr, _
        Criteria2:="<= today()+365"
End With
End Sub

Any help will be greatfully appreciated as will any pointers. I am very new to writing code in VBA but i can already see the immense impact it can have on my Excel abilities

[SamT]

Excel Today() = VBA Date

VBA Date Math:
Today + 335 is CLng(Date) + 335

Example

Sub AddDates()
MsgBox Format(CDate(CLng(Date) + 335), "DDD, dd MMM, yyyy")
End Sub

The CDate() Function converts the numerical value of the math into a date.

nb: I write explicit code even when I know VBA will perform the implied functions in the background.

Implied Function form

Sub AddDates()
MsgBox Date + 335
End Sub

Correction:

Criteria1:=">= today()+335", _
        Operator:=xlAnd, _
        Criteria2:="<= today()+365"

[SamT]

Option Explicit

Private Function BeginPreviousMonth(DateToCheck As Date) As Date
'Replaces the day number with 01
   BeginPreviousMonth = Format(DateAdd("m", -1, DateToCheck), "mmm, 01, yyyy")
End Function

Private Function EndPreviousMonth(DateToCheck As Date) As Date
'Returns the day before the first day of the month after the previous month
   EndPreviousMonth = DateAdd("m", 1, BeginPreviousMonth(DateToCheck)) - 1
End Function

Private Function BeginExpirationInNumYears(DateToCheck As Date, NumYears As Long) As Date
   BeginExpirationInNumYears = DateAdd("yyyy", NumYears, BeginPreviousMonth(DateToCheck))
End Function

Private Function EndExpirationInNumYears(DateToCheck As Date, NumYears As Long) As Date
   EndExpirationInNumYears = DateAdd("yyyy", NumYears, EndPreviousMonth(DateToCheck))
End Function

Sub test1()
    MsgBox BeginExpirationInNumYears(Date, 2)
End Sub

Sub test2()
    MsgBox EndExpirationInNumYears(Date, 3)
End Sub

[ShaneFalco]

SO first i need to convert the date to an integer than i need to do the math on that integer and then i need to return the integer back in date form?

Ok, so i understand how to manipulate your code into giving me message boxes that give me the dates i want.

Now, how do i build that into a filter of my file. Can i add it into the code i already have? Instead of spitting out a date for me it transfers the words over to excel.

Public Sub ExpirationDateFilter()
Dim lo As ListObject
Dim iCol As Long
Set lo = Sheet1.ListObjects(1)
iCol = lo.ListColumns("Expiration").Index
lo.AutoFilter.ShowAllData
With lo.Range
.AutoFilter Field:=iCol, _
Criteria1:=">= BeginExpirationInNumYears(Date, 2)", _
Operator:=xlAnd, _
Criteria2:="<= EndExpirationInNumYears(Date, 2)"
End With
End Sub

[ShaneFalco]

Okay, update with your help and a little back tracking through Excel Macros i was able to come up with this.

Public Sub ExpirationDateFilter1()
Dim x As Date
Dim y As Date
x = BeginExpirationInNumYears(Date, 1)
y = EndExpirationInNumYears(Date, 1)
ActiveSheet.ListObjects("Table1").Range.AutoFilter Field:=7, Criteria1:= _
        ">=" & x, Operator:=xlAnd, Criteria2:="<=" & y
    ActiveWindow.SmallScroll Down:=-6
End Sub

Public Sub ExpirationDateFilter2()
Dim x As Date
Dim y As Date
x = BeginExpirationInNumYears(Date, 2)
y = EndExpirationInNumYears(Date, 2)
ActiveSheet.ListObjects("Table1").Range.AutoFilter Field:=7, Criteria1:= _
        ">=" & x, Operator:=xlAnd, Criteria2:="<=" & y
    ActiveWindow.SmallScroll Down:=-6
End Sub

Public Sub ExpirationDateFilter3()
Dim x As Date
Dim y As Date
x = BeginExpirationInNumYears(Date, 3)
y = EndExpirationInNumYears(Date, 3)
ActiveSheet.ListObjects("Table1").Range.AutoFilter Field:=7, Criteria1:= _
        ">=" & x, Operator:=xlAnd, Criteria2:="<=" & y
    ActiveWindow.SmallScroll Down:=-6
End Sub

these are individual macros for each range i wanted, now for the hard part(the part i dont know how to do) can i combine these three macros into one big macro so that i can see 3 different date ranges on one spread sheet?

[p45cal]

I think you may do better using Advanced filter for this, using a formula as part of the criteria range.
The attached has a formula in cell L2. The criteria range has to be cell L2 and the blank cell above it L1.
L2 formula:

=OR(AND(G2>=EDATE(TODAY(),12),G2<=EDATE(TODAY(),13)),AND(G2>=EDATE(TODAY(),24),G2<=EDATE(TODAY(),25)),AND(G2>=EDATE(TODAY(),36),G2<=EDATE(TODAY(),37)))

By the time you get this, Today() will of course be different, obvs., so you you won't get the same results as on the 1st Oct, it's likely everything will be filtered out by then.

Two buttons; one to filter in place, the second to filter to another location.

Sub Macro1()
On Error Resume Next
ActiveSheet.ShowAllData
On Error GoTo 0
Range("Table1[#All]").AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=Range("L1:L2"), Unique:=False
End Sub

Sub Macro2()
On Error Resume Next
ActiveSheet.ShowAllData
On Error GoTo 0
Range("Table1[#All]").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range("L1:L2"), CopyToRange:=Range("A12"), Unique:=False
End Sub

Note that the formula uses the month ahead based on the date that the macro is run, so if today is the 10th of the month, the dates used are from the 10th of this month to the 10th of the next month, for 1, 2 and 3 years ahead, not from the first of the month; not too difficult to tweak if you want different (it will be a matter of replacing instances of TODAY() in the formula in cell L2 with a variation of EOMONTH(TODAY(),0)+1).

[ShaneFalco]

Thank you!