VBA filter transactions for last quarter data and 1 day before

Knockoutpie

Board Regular
Joined
Sep 10, 2018
Messages
116
Office Version
  1. 365
Platform
  1. Windows
The below snipped captures transaction dates for the last quarter, which is almost perfect, but i need to modify to capture 1 day beyond the last quarter...
Can anyone help me modify that?

Example, Last quarter data is Apr 01 to Jun 30, but I really need Mar 31 to Jun 30.
VBA Code:
    ActiveSheet.Range("$A$1").AutoFilter Field:=2, Criteria1:=11, _
        Operator:=11, Criteria2:=0, SubField:=0
 

Excel Facts

Select all contiguous cells
Pressing Ctrl+* (asterisk) will select the "current region" - all contiguous cells in all directions.
Please try the following on a copy of your workbook. Just change "Sheet1" to the actual sheet name.
VBA Code:
Option Explicit
Sub Knockoutpie()
    Dim ws As Worksheet
    Set ws = Worksheets("Sheet1")   '<~~ *** Change to actual sheet name ***
    Dim StartD As Long, EndD As Long
    StartD = DateSerial(Year(Date), (((Month(Date) - 4) \ 3) * 3) + 1, 0)
    EndD = DateSerial(Year(Date), (((Month(Date) - 1) \ 3) * 3) + 1, 0)
    
    With ws.Range("A1").CurrentRegion
        .AutoFilter 2, ">=" & CLng(StartD), 1, "<=" & CLng(EndD)
    End With
End Sub

Before:
Book1
ABC
1hdr1Datehdr3
2data10/03/2023data
3data17/03/2023data
4data24/03/2023data
5data31/03/2023data
6data10/04/2023data
7data20/04/2023data
8data30/04/2023data
9data10/05/2023data
10data20/05/2023data
11data30/05/2023data
12data09/06/2023data
13data19/06/2023data
14data30/06/2023data
15data09/07/2023data
16data19/07/2023data
17data29/07/2023data
18data08/08/2023data
Sheet1


After:
Book1
ABC
1hdr1Datehdr3
5data31/03/2023data
6data10/04/2023data
7data20/04/2023data
8data30/04/2023data
9data10/05/2023data
10data20/05/2023data
11data30/05/2023data
12data09/06/2023data
13data19/06/2023data
14data30/06/2023data
19
Sheet1
 
Upvote 0
Please try the following on a copy of your workbook. Just change "Sheet1" to the actual sheet name.
VBA Code:
Option Explicit
Sub Knockoutpie()
    Dim ws As Worksheet
    Set ws = Worksheets("Sheet1")   '<~~ *** Change to actual sheet name ***
    Dim StartD As Long, EndD As Long
    StartD = DateSerial(Year(Date), (((Month(Date) - 4) \ 3) * 3) + 1, 0)
    EndD = DateSerial(Year(Date), (((Month(Date) - 1) \ 3) * 3) + 1, 0)
   
    With ws.Range("A1").CurrentRegion
        .AutoFilter 2, ">=" & CLng(StartD), 1, "<=" & CLng(EndD)
    End With
End Sub

Before:
Book1
ABC
1hdr1Datehdr3
2data10/03/2023data
3data17/03/2023data
4data24/03/2023data
5data31/03/2023data
6data10/04/2023data
7data20/04/2023data
8data30/04/2023data
9data10/05/2023data
10data20/05/2023data
11data30/05/2023data
12data09/06/2023data
13data19/06/2023data
14data30/06/2023data
15data09/07/2023data
16data19/07/2023data
17data29/07/2023data
18data08/08/2023data
Sheet1


After:
Book1
ABC
1hdr1Datehdr3
5data31/03/2023data
6data10/04/2023data
7data20/04/2023data
8data30/04/2023data
9data10/05/2023data
10data20/05/2023data
11data30/05/2023data
12data09/06/2023data
13data19/06/2023data
14data30/06/2023data
19
Sheet1
I did some testing on your QTR filters. It works for 2nd,3rd,&4th, but not for 1st QTR dates
If your input date is 1/1/2023 - 3/31/2023 the
StartDate should be 9/30/2022
EndDate should be 12/31/2022
Your code is generating for Feb and March dates (2023)
StartDate 12/31/2022
EndDate(s) are OK

This is the code I used and tested
VBA Code:
'note replace dt in the code below with Date for the AutoFilter function
StartDate = DateAdd("m", -3, DateAdd("d", -1, DateSerial(Year(dt), Int((Month(dt) - 1) / 3) * 3 + 1, 1)))
EndDate = DateAdd("d", -1, DateSerial(Year(dt), (Int((Month(dt) - 1) / 3) * 3 + 1), 1))
 
Upvote 0
It works for 2nd,3rd,&4th, but not for 1st QTR dates
And yet when I test it, it does return the correct dates...
VBA Code:
Option Explicit
Sub Knockoutpie_Test()
    Dim StartD As Long, EndD As Long, testD As Long
    testD = 44927   '<~~ *** numerical equivalent to 1/1/2023 ***
    StartD = DateSerial(Year(testD), (((Month(testD) - 4) \ 3) * 3) + 1, 0)
    EndD = DateSerial(Year(testD), (((Month(testD) - 1) \ 3) * 3) + 1, 0)

    Debug.Print Format(StartD, "dd/mm/yyyy")
    Debug.Print Format(EndD, "dd/mm/yyyy")
End Sub
 
Upvote 0
And yet when I test it, it does return the correct dates...
VBA Code:
Option Explicit
Sub Knockoutpie_Test()
    Dim StartD As Long, EndD As Long, testD As Long
    testD = 44927   '<~~ *** numerical equivalent to 1/1/2023 ***
    StartD = DateSerial(Year(testD), (((Month(testD) - 4) \ 3) * 3) + 1, 0)
    EndD = DateSerial(Year(testD), (((Month(testD) - 1) \ 3) * 3) + 1, 0)

    Debug.Print Format(StartD, "dd/mm/yyyy")
    Debug.Print Format(EndD, "dd/mm/yyyy")
End Sub
I plugged it into Excel 2016 and had issues
Book1
EFGH
1DatePrev Q StartPrev Q EndExpected Q start
21/1/20239/30/2212/31/229/30/2022
32/1/202312/31/2212/31/229/30/2022
43/1/202312/31/2212/31/229/30/2022
54/1/202312/31/223/31/23
Sheet1
Cell Formulas
RangeFormula
F2:F5F2=qstartdate(E2)
G2:G5G2=QendDate(E2)


VBA Code:
Function QStartDate(dt)
  QStartDate = DateSerial(Year(dt), (((Month(dt) - 4) \ 3) * 3 + 1), 0)
' QStartDate = DateAdd("m", -3, DateAdd("d", -1, DateSerial(Year(dt), Int((Month(dt) - 1) / 3) * 3 + 1, 1)))
End Function

Function QEndDate(dt)
  QEndDate = DateSerial(Year(dt), (((Month(dt) - 1) \ 3) * 3 + 1), 0)
'  QEndDate = DateAdd("d", -1, DateSerial(Year(dt), (Int((Month(dt) - 1) / 3) * 3 + 1), 1))
End Function
 
Upvote 0
It certainly works in 365 - which I note the OP has indicated they are running.
 
Upvote 0

Forum statistics

Threads
1,215,200
Messages
6,123,612
Members
449,109
Latest member
Sebas8956

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top