Run-time error '1004': Application definted or Object defined error

[Damian37]

Hello,
I've built some VBA code to randomly select 10% of records from data set. I'm currently receiving the Run-time error '1004' when I run the macro. The error that's coming up occurs when the code is supposed to randomly select records from the filtered data. Also, even though I get an error, data is still being copied on to the new sheet, but instead of it just being data from the filtered month, it looks like the records being selected are from multiple months. Plus, after the code has run, I receive the run-time error, and when I click on debug the following line is highlighted: "Rows(RowNb).Copy Destination:=Sheets("Sheet1").Cells(k, "A")". The code was working just fine when I was using the general date column, and now that I've changed the column to the "Disposition Date" column the code isn't doing what was doing when I was using the general "Date" column. I modified the code to include the new column, and I changed the Field from 7 to 9, but I'm receiving incorrect results. The new code is below. I've separated each section to run them each independently and once I get to the Copy sub section, that's when I receive the error.

Sub Filter_by_Last_month()
'
' Filter_by_month Macro

    If ActiveSheet.AutoFilterMode Then ActiveSheet.AutoFilterMode = False
    Sheets("FILENAME").Range("A:I").AutoFilter Field:=9, Criteria1:=xlFilterLastMonth, _
    Operator:=xlFilterDynamic
End Sub

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"
End Sub

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

End Sub

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 also loaded a sample workbook on google drive for you to test the code yourself. The link is:

drive.google.com

Any help anyone can provide, I would greatly appreciate. Thank you.

D.

 

[MARK858]

You need to mark the file for sharing

As a guess I would say RowNb at some stage returned a 0

 

[Damian37]

You need to mark the file for sharing

As a guess I would say RowNb at some stage returned a 0

Hi thanks for letting me know it wasn't set to share. I believe I have now made it available. When I hover over RowNb i see it's showing RowNb = 139. I can't seem to figure out why I continue to get this error. Hopefully this link will open the document up for you.

drive.google.com

Thanks for taking a look at it.

D.

 

[MARK858]

I'm getting the error when RowNb = 0

Add the lines in red and hover your mouse over RowNb when you get the message box, then let the code run and you'll get the error

    For i = 1 To NbRows
        RowNb = Rnd() * LastRow
        If RowNb < 1 Then
            MsgBox "????"
            Stop
        End If
        Rows(RowNb).Copy Destination:=Sheets("Sheet1").Cells(k, "A")
        k = k + 1

 

[Damian37]

I'm getting the error when RowNb = 0

Add the lines in red and hover your mouse over RowNb when you get the message box, then let the code run and you'll get the error

    For i = 1 To NbRows
        RowNb = Rnd() * LastRow
        If RowNb < 1 Then
            MsgBox "????"
            Stop
        End If
        Rows(RowNb).Copy Destination:=Sheets("Sheet1").Cells(k, "A")
        k = k + 1

I added the snippet to my code and ran it. I received the message box, but when I hover over NbRows I receive NbRows = 139. I'm not seeing 0, so this is why I'm not sure why I continue to get this error.

D.

 

[MARK858]

Are you hovering the mouse over the RowNb before the message box line?Asking because you won't get the message box unless RowNb is less than one when it reaches the If statement.

Please note you should be looking at RowNb not NbRows