Excel VBA - Filter by months in the future

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!
 

Some videos you may like

Excel Facts

Repeat Last Command
Pressing F4 adds dollar signs when editing a formula. When not editing, F4 repeats last command.

Puertorekinsam

Active Member
Joined
Oct 8, 2005
Messages
287
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
 

elysa

New Member
Joined
Oct 5, 2020
Messages
3
Office Version
  1. 2016
Platform
  1. Windows
  2. MacOS
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

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.
 

Puertorekinsam

Active Member
Joined
Oct 8, 2005
Messages
287
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")
 

elysa

New Member
Joined
Oct 5, 2020
Messages
3
Office Version
  1. 2016
Platform
  1. Windows
  2. MacOS
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")
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.
 

Puertorekinsam

Active Member
Joined
Oct 8, 2005
Messages
287
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
 

Watch MrExcel Video

Forum statistics

Threads
1,127,736
Messages
5,626,592
Members
416,194
Latest member
Dhisilva_aguiar

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
Top