FIlter by # of days using VBA

[Damian37]

Hello,
I'm attempting to update my autofilter criteria from one month to seven days, however, I'm receiving a run-time error '9': subscript out of Range. The line of code that is being highlighted as the cause of the error is: "ReDim RowList(1 To NbRows)". The code appears to be working until it gets to the section to randomly select 10% of the data population. A new sheet is created, and the headers are copied over, but when the code has to randomly select, copy, and paste data, this is where the code breaks. I would really appreciate any suggestions as to what might be causing this would be greatly appreciated. Here's the code I currently have:

Sub Filter_by_Week()

' Filter_by_week_Macro

    Dim todayDate As Date
    Dim sevenDaysAgo As Date
    todayDate = Date
    sevenDaysAgo = DateAdd("d", -7, todayDate)
    
    Sheets("FILENAME").Range("A:M").AutoFilter Field:=7, Criteria1:=">=sevenDaysAgo", _
    Operator:=xlAnd, Criteria2:="<=todaydate"

'Sub CreateSheet()

Application.DisplayAlerts = False
 
  On Error Resume Next
  Sheets("Sheet1").Delete
  On Error GoTo 0
  Sheets.Add After:=Sheets(Sheets.Count)
  ActiveSheet.Name = "Sheet1"
 
'Sub Copy_Header()

Application.ScreenUpdating = False
Dim h As Long

    For h = 2 To Sheets.Count
        Sheets("FILENAME").Rows(1).Copy Destination:=Sheets("Sheet1").Rows(1)
    Next
Sheets("Sheet1").Cells(1, 1).Select
Application.CutCopyMode = False
Application.ScreenUpdating = True

'Sub Copy()
Dim LastRow As Long
Dim NbRows As Long
Dim RowList()
Dim i As Long, J As Long, k As Long
Dim RowNb As Long
Dim s As String
Sheets("FILENAME").Activate


Application.ScreenUpdating = False
For i = 1 To Range("A" & Rows.Count).End(xlUp).Row
    s = i & ":" & i
    If IsEmpty(Cells(i, 1).Value) Then
         Rows(s).EntireRow.Hidden = False
    End If
Next
Application.ScreenUpdating = True
    
    
    Sheets("FILENAME").Activate
    
    LastRow = Range("A" & Rows.Count).End(xlUp).Row
    NbRows = LastRow * 0.1


    ReDim RowList(1 To NbRows)


    k = 2
    For i = 1 To NbRows
        RowNb = Rnd() * LastRow
        Rows(RowNb).Copy Destination:=Sheets("Sheet1").Cells(k, "A")
        k = k + 1
NextStep:
    Next i
End Sub

I've spaced out the line of code that is failing within the code section, as well as written it above in bold and italics.

 

[DanteAmor]

The error may be due to having a 0 in the NbRows variable.
When the error appears, press the debug button, bring the mouse pointer closer to the NbRows variable and verify the number that appears or open the Locals Window and verify the value in said variable.

​

If it is zero, perhaps there are no dates for that period.
I did a test and if there are dates in that period, then I have no error on that line.


Try:
Change this line:

LastRow = Range("A" & Rows.Count).End(xlUp).Row

For this:

LastRow = Range("G" & Rows.Count).End(xlUp).Row

"G" is the column where you have the dates.

----- --
I hope to hear from you soon.
Respectfully
Dante Amor
----- --

 

[Damian37]

The error may be due to having a 0 in the NbRows variable.
When the error appears, press the debug button, bring the mouse pointer closer to the NbRows variable and verify the number that appears or open the Locals Window and verify the value in said variable.

View attachment 102050​

View attachment 102048​

​

If it is zero, perhaps there are no dates for that period.
I did a test and if there are dates in that period, then I have no error on that line.


Try:
Change this line:

LastRow = Range("A" & Rows.Count).End(xlUp).Row

For this:

LastRow = Range("G" & Rows.Count).End(xlUp).Row

"G" is the column where you have the dates.

----- --
I hope to hear from you soon.
Respectfully
Dante Amor
----- --

Hi Dante,
I tried to change the code as you suggested, but I'm still receiving the same error.

D.

 

[DanteAmor]

When the error appears, press the debug button, bring the mouse pointer closer to the NbRows variable and verify the number that appears or open the Locals Window and verify the value in said variable.

Did you check that?


You could upload a copy of your file to a free site such www.dropbox.com or google drive. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here. If the workbook contains confidential information, you could replace it with generic data.

 

[Damian37]

Did you check that?


You could upload a copy of your file to a free site such www.dropbox.com or google drive. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here. If the workbook contains confidential information, you could replace it with generic data.

Yes, and when I hovered over it, the number that appeared is 0.

 

[DanteAmor]

the number that appeared is 0.

Then check this:

If it is zero, perhaps there are no dates for that period.
I did a test and if there are dates in that period, then I have no error on that line.