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

Which came first: VisiCalc or Lotus 1-2-3?
Dan Bricklin and Bob Frankston debuted VisiCalc in 1979 as a Visible Calculator. Lotus 1-2-3 debuted in the early 1980's, from Mitch Kapor.
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

W
  • Solved
Looking For Tips To Improve My VBA
Replies
8
Views
231
who am i
W
G
  • Solved
Run-Time Error 381
2
Replies
12
Views
201
Micron
M
D
  • Solved
Merge files and keep source formatting.
Replies
9
Views
350
Alex Blakenburg
A
G
  • Question Question
Cannot create a new time-in entry
Replies
2
Views
185
genesix
G
B
  • Solved
Object required error
Replies
2
Views
163
Boston_Paul
B

Forum statistics

Threads
1,224,820
Messages
6,181,159
Members
453,021
Latest member
Justyna P

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