Excel VBA - Filter by months in the future

E

elysa

New Member
Joined
Oct 5, 2020
Messages
3
Office Version
  1. 2016
Platform
  1. Windows
  2. MacOS
I am new to VBA and I am struggling to define filters by which my data should be copied to an overview sheet. I would like for all rows to appear that contain the current month plus all dates in the next three months. My current date format is MMMM YYYY (Oct 20 etc.). This is my current code, it works very well, but I dont want to update it each month. I tried a few codes I found on here but nothing worked, maybe because I dont use Autofilter or because my date format is a bit weird? The relevant code part starts from:
VBA Code: 
For i = 1 To nRows

VBA Code: 
Public Sub CopyRows()

Dim ws As Worksheet
Dim s_Main As String
Dim nRow As Long
Dim Last_row As Long
Dim i As Long
Dim Table As Variant

s_Main = "Overview"
Last_row = Worksheets(s_Main).Cells(Rows.Count, 1).End(xlUp).Row
Worksheets(s_Main).Range("A2:P" & Last_row).ClearContents

For Each ws In Worksheets
    If ws.Name = s_Main Then
        GoTo Change_ws
    Else
        nRows = ws.Cells(Rows.Count, 1).End(xlUp).Row
        ReDim Table(nRows, 16)
        Table = ws.Range("A1:P" & nRows)
        For i = 1 To nRows
            If Table(i, 2) = "01.09.2020" Or Table(i, 2) = "01.10.2020" Or Table(i, 2) = "01.11.2020" Then
                Last_row = Worksheets(s_Main).Cells(Rows.Count, 1).End(xlUp).Row
                ws.Range("A" & i & ":P" & i).Copy Worksheets(s_Main).Range("A" & Last_row)(2)
            End If
        Next i
    End If
Change_ws:

Next ws
End Sub

Any help would be appreciated! Thanks!
 

Excel Facts

Can you sort left to right?
To sort left-to-right, use the Sort dialog box. Click Options. Choose "Sort left to right"
Sort by date Sort by votes
Is the date in question "TODAY" ?

This is a quick and dirty way to handle it if it is.

Code: 
Public Sub CopyRows()

Dim ws As Worksheet
Dim s_Main As String
Dim nRow As Long
Dim Last_row As Long
Dim i As Long
Dim Table As Variant

Dim x as integer
Dim y as interger
Dim Date1 as string
Dim Date2 as string
Dim Date3 as string


s_Main = "Overview"
Last_row = Worksheets(s_Main).Cells(Rows.Count, 1).End(xlUp).Row
Worksheets(s_Main).Range("A2:P" & Last_row).ClearContents

x = Format(Date, "mm")
y = Format(Date, "yyyy")
Date1 = "01." & x & "." & y
If x = 12 Then
    x = 1
    y = y + 1
Else
    x = x + 1
End If
Date2 = "01." & x & "." & y
If x = 12 Then
    x = 1
    y = y + 1
Else
    x = x + 1
End If
Date3 = "01." & x & "." & y



For Each ws In Worksheets
    If ws.Name = s_Main Then
        GoTo Change_ws
    Else
        nRows = ws.Cells(Rows.Count, 1).End(xlUp).Row
        ReDim Table(nRows, 16)
        Table = ws.Range("A1:P" & nRows)
        For i = 1 To nRows
            If Table(i, 2) = Date1 Or Table(i, 2) = Date2 Or Table(i, 2) = Date3 Then
                Last_row = Worksheets(s_Main).Cells(Rows.Count, 1).End(xlUp).Row
                ws.Range("A" & i & ":P" & i).Copy Worksheets(s_Main).Range("A" & Last_row)(2)
            End If
        Next i
    End If
Change_ws:

Next ws
End Sub
 
Upvote 0
Puertorekinsam said:
Is the date in question "TODAY" ?

This is a quick and dirty way to handle it if it is.

Code: 
Public Sub CopyRows()

Dim ws As Worksheet
Dim s_Main As String
Dim nRow As Long
Dim Last_row As Long
Dim i As Long
Dim Table As Variant

Dim x as integer
Dim y as interger
Dim Date1 as string
Dim Date2 as string
Dim Date3 as string


s_Main = "Overview"
Last_row = Worksheets(s_Main).Cells(Rows.Count, 1).End(xlUp).Row
Worksheets(s_Main).Range("A2:P" & Last_row).ClearContents

x = Format(Date, "mm")
y = Format(Date, "yyyy")
Date1 = "01." & x & "." & y
If x = 12 Then
    x = 1
    y = y + 1
Else
    x = x + 1
End If
Date2 = "01." & x & "." & y
If x = 12 Then
    x = 1
    y = y + 1
Else
    x = x + 1
End If
Date3 = "01." & x & "." & y



For Each ws In Worksheets
    If ws.Name = s_Main Then
        GoTo Change_ws
    Else
        nRows = ws.Cells(Rows.Count, 1).End(xlUp).Row
        ReDim Table(nRows, 16)
        Table = ws.Range("A1:P" & nRows)
        For i = 1 To nRows
            If Table(i, 2) = Date1 Or Table(i, 2) = Date2 Or Table(i, 2) = Date3 Then
                Last_row = Worksheets(s_Main).Cells(Rows.Count, 1).End(xlUp).Row
                ws.Range("A" & i & ":P" & i).Copy Worksheets(s_Main).Range("A" & Last_row)(2)
            End If
        Next i
    End If
Change_ws:

Next ws
End Sub
Click to expand...

Thank you so much, this works very well. What must I do so it regards the current day as well, lets say if I change to a full date (DD.MM.YYYY)? I know I must add another integer but I can't get the right code! My goal is that everything that is in the past isn't regarded.
 
Upvote 0
I'm not sure how you are feeding the date into the program, but you would want to edit these two lines here:

Code: 
x = Format(Date, "mm")
y = Format(Date, "yyyy")


if the date is static, and you just want it to me one day more you will need to swap the word 'Date' with the following:

Code: 
(DateAdd("d", 1, Date))

this function says you want to adjust a date.
  1. the first variable is the length of change: 'd' means day, you could also use 'm' for month, 'q' for quarter, or 'y' for year. or even 'w' for a weekday.
  2. the second variable is how many changes to make... this is the integer you were asking for.
  3. the final variable is the starting date. In VBA, the word "Date" is today's date.
    1. This could be updated to a cell reference so you don't need to update the code,
    2. you could also make this an input by usinging the following code
      Code: 
      changes = InputBox("What is the first date you would like to include?", "Start Date", Date)

x = Format((DateAdd("d", 1, changes )), "mm")
y = Format((DateAdd("d", 1, changes )), "yyyy")
 
Upvote 0
Puertorekinsam said:
I'm not sure how you are feeding the date into the program, but you would want to edit these two lines here:

Code: 
x = Format(Date, "mm")
y = Format(Date, "yyyy")


if the date is static, and you just want it to me one day more you will need to swap the word 'Date' with the following:

Code: 
(DateAdd("d", 1, Date))

this function says you want to adjust a date.
  1. the first variable is the length of change: 'd' means day, you could also use 'm' for month, 'q' for quarter, or 'y' for year. or even 'w' for a weekday.
  2. the second variable is how many changes to make... this is the integer you were asking for.
  3. the final variable is the starting date. In VBA, the word "Date" is today's date.
    1. This could be updated to a cell reference so you don't need to update the code,
    2. you could also make this an input by usinging the following code
      Code: 
      changes = InputBox("What is the first date you would like to include?", "Start Date", Date)

x = Format((DateAdd("d", 1, changes )), "mm")
y = Format((DateAdd("d", 1, changes )), "yyyy")
Click to expand...
Thank you so much, but I am sadly too new to Excel and I dont really get your suggestions. Adding either of these codes like you explained doesn't do anything Currently everything apart from 01.10.2020 01.11.2020 or 01.12.2020 doesnt appear, but I want it to appear if it says 10.11.2020, but at the same time it shouldnt appear if it is 05.10.2020 because its passed. I am probably not explaining myself very precisely, but I want Excel to read also the date and not only the month and year.
 
Upvote 0
Now I understand...

If your date reads as a date this should work
Code: 
Public Sub CopyRows()

Dim ws As Worksheet
Dim s_Main As String
Dim nRow As Long
Dim Last_row As Long
Dim i As Long
Dim Table As Variant

Dim x As Integer
Dim y As interger
Dim Date1 As String
Dim Date2 As String
Dim Date3 As String


s_Main = "Overview"
Last_row = Worksheets(s_Main).Cells(Rows.Count, 1).End(xlUp).Row
Worksheets(s_Main).Range("A2:P" & Last_row).ClearContents

x = Format(Date, "mm")
y = Format(Date, "yyyy")
Date1 = "01." & x & "." & y
If x = 12 Then
    x = 1
    y = y + 1
Else
    x = x + 1
End If
Date2 = "01." & x & "." & y
If x = 12 Then
    x = 1
    y = y + 1
Else
    x = x + 1
End If
Date3 = "01." & x & "." & y



For Each ws In Worksheets
    If ws.Name = s_Main Then
        GoTo Change_ws
    Else
        nRows = ws.Cells(Rows.Count, 1).End(xlUp).Row
        ReDim Table(nRows, 16)
        Table = ws.Range("A1:P" & nRows)
        For i = 1 To nRows
            If (Month(Table(i, 2)) = Month(Date1) And Year(Table(i, 2)) = Year(Date1)) Or (Month(Table(i, 2)) = Month(Date2) And Year(Table(i, 2)) = Year(Date2)) Or (Month(Table(i, 2)) = Month(Date3) And Year(Table(i, 2)) = Year(Date31)) Then
                Last_row = Worksheets(s_Main).Cells(Rows.Count, 1).End(xlUp).Row
                ws.Range("A" & i & ":P" & i).Copy Worksheets(s_Main).Range("A" & Last_row)(2)
            End If
        Next i
    End If
Change_ws:

Next ws
End Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

D
  • Solved
VBA to move data to new sheets based off cell values
Replies
3
Views
196
Tupe77
T
R
  • Solved
calculate month from date
Replies
3
Views
172
robertvdb
R
C
  • Question
Find duplicates when pulling data from other sheets
Replies
3
Views
176
Trebor76
T
T
  • Question
Remove Duplicates with Dynamic Columns Array
Replies
0
Views
293
trough
T
E
  • Question
VBA + Outlook
Replies
1
Views
155
Edson Santos 294
E

Forum statistics

Threads
1,214,791
Messages
6,121,611
Members
449,038
Latest member
apwr

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