Create Macro to filter dates up to yesterday

F

Flora2021

New Member
Joined
Apr 28, 2022
Messages
44
Office Version
  1. 365
Platform
  1. Windows
Hi, I have a daily report where I have several columns of data where I have to filter the date range up to yesterday's date of the day I am creating report for example today is 5/16. I would have to filter all dates in this column that include up to 5/15. Then go to the second column and filter that one same way, and finally the last 3rd row. I then Copy the filtered data to a new tab. I have searched online but I cannot seem to find a similar process to find a macro solution, Thank you.
 

Attachments

  • Capture.JPG
    Capture.JPG
    55.9 KB · Views: 13

Excel Facts

Bring active cell back into view
Start at A1 and select to A9999 while writing a formula, you can't see A1 anymore. Press Ctrl+Backspace to bring active cell into view.
Sort by date Sort by votes
Try the following on a copy of your workbook. Change the sheet names to suit.

VBA Code: 
Option Explicit
Sub Flora2021()
    Dim ws1 As Worksheet, ws2 As Worksheet
    Set ws1 = Worksheets("Sheet1")  '<~~ *** Change the sheet names to suit ***
    Set ws2 = Worksheets("Sheet2")
    
    Dim Ystrday As Long
    Ystrday = CLng(Date - 1)
    With ws1.Range("A1").CurrentRegion
        .AutoFilter 10, "<=" & Ystrday
        .AutoFilter 14, "<=" & Ystrday
        .AutoFilter 15, "<=" & Ystrday
        If ws1.UsedRange.SpecialCells(xlCellTypeVisible).Rows.Count > 1 Then
            .Offset(1).Resize(.Rows.Count - 1).Copy ws2.Range("A" & ws2.Cells(Rows.Count, "A").End(xlUp).Row).Offset(1)
        End If
        .AutoFilter
    End With
    
End Sub
 
Upvote 0
Hi, tried to use this macro and it did not change anything in the sheet at all. nor did it give me an errors. I copied it, and run it and it acted like it was doing something, but nothing changed.
My sheet names I named to match yours in example.
 
Upvote 0
When I ran the code on a test sheet I created, it takes this data set:
Flora2021.xlsm
ABCDEFGHIJKLMNOPQR
1HDR1HDR2HDR3HDR4HDR5HDR6HDR7HDR8HDR9Date1HDR11HDR12HDR13Date2Date3HDR16HDR17HDR18
2datadatadatadatadatadatadatadatadata05-12-2023datadatadata05-17-202305-20-2023datadatadata
3datadatadatadatadatadatadatadatadata05-13-2023datadatadata05-18-202305-21-2023datadatadata
4datadatadatadatadatadatadatadatadata05-14-2023datadatadata05-19-202305-22-2023datadatadata
5datadatadatadatadatadatadatadatadata05-15-2023datadatadata05-20-202305-23-2023datadatadata
6datadatadatadatadatadatadatadatadata05-16-2023datadatadata05-21-202305-24-2023datadatadata
7datadatadatadatadatadatadatadatadata05-17-2023datadatadata05-22-202305-25-2023datadatadata
8datadatadatadatadatadatadatadatadata05-18-2023datadatadata05-23-202305-26-2023datadatadata
9datadatadatadatadatadatadatadatadata05-19-2023datadatadata05-24-202305-27-2023datadatadata
10datadatadatadatadatadatadatadatadata05-20-2023datadatadata05-25-202305-28-2023datadatadata
11datadatadatadatadatadatadatadatadata05-21-2023datadatadata05-26-202305-29-2023datadatadata
12datadatadatadatadatadatadatadatadata05-22-2023datadatadata05-27-202305-30-2023datadatadata
13datadatadatadatadatadatadatadatadata05-23-2023datadatadata05-28-202305-31-2023datadatadata
14datadatadatadatadatadatadatadatadata05-24-2023datadatadata05-29-202306-01-2023datadatadata
Sheet1


And copies the data to sheet 2 like this (bearing in mind today is 24th May where I am):
Flora2021.xlsm
ABCDEFGHIJKLMNOPQR
1HDR1HDR2HDR3HDR4HDR5HDR6HDR7HDR8HDR9Date1HDR11HDR12HDR13Date2Date3HDR16HDR17HDR18
2datadatadatadatadatadatadatadatadata05-12-2023datadatadata05-17-202305-20-2023datadatadata
3datadatadatadatadatadatadatadatadata05-13-2023datadatadata05-18-202305-21-2023datadatadata
4datadatadatadatadatadatadatadatadata05-14-2023datadatadata05-19-202305-22-2023datadatadata
5datadatadatadatadatadatadatadatadata05-15-2023datadatadata05-20-202305-23-2023datadatadata
6
Sheet2


So the code certainly works for me. I'm willing to look at this again IF you can provide a copy of your actual data using the XL2BB - Excel Range to BBCode, or better still, if you share your actual file via Dropbox, Google Drive or similar file sharing platform.
 
Upvote 0
Hi, Please see link for the test file.
Thanks for your help. I gave up on this for a while because I have had to move on to other projects that took priority but I really would love to try and figure this out since it is now back on my plate.

Export_Macro_Test.xls
 
Upvote 0
Thank you for providing the actual data, it makes life so much simpler. I note that your actual data doesn't have anything in cell A1 - whereas your image in post #1 does: that makes a big difference because it throws out the column numbers. The following code is written assuming you won't have anything in cell A1 of your actual data (as per the sample you provided). If it does, the code will need to be rewritten. Special mention to my good colleague @Alex Blakenburg for the codeline to test whether any records are returned. I've assumed that you already have a header row on your destination sheet, and the data is being placed starting in column B as I think that may be what you want? If not, it's easily changed. Try it and see.

VBA Code: 
Option Explicit
Sub test2()
    Dim ws1 As Worksheet, ws2 As Worksheet
    Set ws1 = Worksheets("Sheet1")  '<~~ *** Change the sheet names to suit ***
    Set ws2 = Worksheets("Sheet2")
   
    Dim Ystrday As Long
    Ystrday = CLng(Date - 1)
   
    If ws1.AutoFilterMode Then ActiveSheet.AutoFilter.ShowAllData
   
    With ws1.Range("B1").CurrentRegion
        .AutoFilter 9, "<=" & Ystrday
        .AutoFilter 13, "<=" & Ystrday
        .AutoFilter 14, "<=" & Ystrday
        If .SpecialCells(xlCellTypeVisible).Address <> .Rows(1).Address Then
            .Offset(1).Resize(.Rows.Count - 1).Copy ws2.Range("B" & ws2.Cells(Rows.Count, "B").End(xlUp).Row).Offset(1)
        End If
        .AutoFilter
    End With

End Sub
 
Upvote 0
Hi, It almost is working the way I need it and i really apprecaite your help. The data in column A, will be added later from a vlookup source so I just deleted it for now to see if I could get this to work.
I used your new code and added new sheet with headers, it worked except I forgot to mention that it should also include data in these three columns that are also blank as in they do not have a date entered. I am so sorry I forgot to mention that.
 
Upvote 0
Try this
VBA Code: 
Option Explicit
Sub test3()
    Dim ws1 As Worksheet, ws2 As Worksheet
    Set ws1 = Worksheets("Sheet1")  '<~~ *** Change the sheet names to suit ***
    Set ws2 = Worksheets("Sheet2")
    
    Dim Ystrday As Long
    Ystrday = CLng(Date - 1)
    
    If ws1.AutoFilterMode Then ActiveSheet.AutoFilter.ShowAllData
    
    With ws1.Range("B1").CurrentRegion
        .AutoFilter 9, "<=" & Ystrday, 2, "="
        .AutoFilter 13, "<=" & Ystrday, 2, "="
        .AutoFilter 14, "<=" & Ystrday, 2, "="
        If .SpecialCells(xlCellTypeVisible).Address <> .Rows(1).Address Then
            .Offset(1).Resize(.Rows.Count - 1).Copy ws2.Range("B" & ws2.Cells(Rows.Count, "B").End(xlUp).Row).Offset(1)
        End If
        .AutoFilter
    End With
End Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

C
  • Question
How do I highlight a cell where yesterday's date has passed?
Replies
5
Views
216
AlanY
A
M
  • Solved
How to Wrap MINIFS around Filter Function
Replies
8
Views
234
Fluff
Fluff
R
  • Question
Filtering by "yesterday's" date
Replies
3
Views
308
kevin9999
K
L
  • Question
Filter date range to last 365 days (Pivot Table)
Replies
2
Views
491
LeonardH
L
D
  • Question
filter loop
Replies
2
Views
181
Joe4
Joe4

Forum statistics

Threads
1,215,555
Messages
6,125,490
Members
449,234
Latest member
slzaleski

Share this page

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