Selecting rows randomly in Excel

[Damian37]

I'm trying to select random rows within my Active Worksheet filtered data, copy the rows, and have them pasted within another sheet in the workbook. I'm trying to use this code, however I keep getting an error on the Else statement for the TargetRows. Here's the code:

Sub Row_Selection()

    Const STARTROW As Long = 1

    Dim LastRow As Long

    LastRow = ActiveSheet.Cells(ActiveSheet.Rows.Count, 1).End(xlUp).Row

  
    Dim RowArr() As Long

    ReDim RowArr(STARTROW To LastRow)

  
    Dim i As Long

    For i = LBound(RowArr) To UBound(RowArr)

        RowArr(i) = i

    Next i

  
    Randomize

    Dim tmp As Long, RndNum As Long

    For i = LBound(RowArr) To UBound(RowArr)

        RndNum = WorksheetFunction.Floor((UBound(RowArr) - LBound(RowArr) + 1) * Rnd, 1) + LBound(RowArr)

        tmp = RowArr(i)

        RowArr(i) = RowArr(RndNum)

        RowArr(RndNum) = tmp

    Next i

    Const LIMIT As Double = 0.1 '10%

    Dim Size As Long

    Size = WorksheetFunction.Ceiling((UBound(RowArr) - LBound(RowArr) + 1) * LIMIT, 1)

    If Size > UBound(RowArr) Then Size = UBound(RowArr)

  
    Dim TargetRows As Range

    For i = LBound(RowArr) To LBound(RowArr) + Size

        If TargetRows Is Nothing Then

            Set TargetRows = ActiveSheet.Rows(RowArr(i))

        Else

            Set TargetRows = Union(TargetRows, ActiveSheet.Rows(RowArr(i)))

        End If

    Next i


    Dim OutPutRange As Range

    Set OutPutRange = Sheet1.Cells(1, 1) 'Top Left Corner

  
    TargetRows.Copy Destination:=OutPutRange.Resize(TargetRows.Rows.Count).EntireRow

  

End Sub

I'm unsure where the hiccup is. The code breaks at the TargetRows section of the code. Thank you in advance.

D.

 

[DanteAmor]

I only have an error when your active sheet has one record or none in column A.
Check that you have data in column A.

 

[Damian37]

I only have an error when your active sheet has one record or none in column A.
Check that you have data in column A.

When trying to run the code using my file with Data, it's still breaking at the TargetRows line. There is data in ActiveSheet Cell A within my spreadsheet, and when I run the filter portion of my code, the data filters just fine, however, the next part that selects random rows is breaking. Not sure why it breaks at TargetRows when the areas are already filtered.

D.

 

[rlv01]

I keep getting an error on the Else statement for the TargetRows. Here's the code:

For that error, my testing matches what @DanteAmor said. If there is not data in at least the first two rows in column A, you get an error. If you have more data in column A and are still getting an error, then my guess would be that for some reason ActiveSheet.Rows(RowArr(i)) is not evaluating to a valid range. Use the VBE debugger to inspect variables to see what might cause that.

For errors, you should get into the habit of always providing certain information. For a runtime error you should report 3 things:

1. Error number
2. Error message
3. Line of code that generates the error.

 

[DanteAmor]

LastRow = ActiveSheet.Cells(ActiveSheet.Rows.Count, 1).End(xlUp).Row

Set OutPutRange = Sheet1.Cells(1, 1)

Do you have 2 sheets?
The activesheet and sheet1?
You must run the macro on the sheet that contains the data.

 

[Damian37]

Do you have 2 sheets?
The activesheet and sheet1?
You must run the macro on the sheet that contains the data.

Hi,
Yes, there is plenty of data within the ActiveSheet in the workbook. There is also a sheet 1 tab which is where I want the random selection to be placed. I am running the macro on the ActiveSheet which is where the data is located. As I said previously, the filter portion of the code that I have is working just fine on the ActiveSheet, but the random selection code is where I run into the error. I will try to go through the debugger to see if I can figure out why I'm receiving the error. If you have any other ideas as to what might be causing the error, since I can tell you there is data to work with, I would greatly appreciate it. Thank you.

 

[Damian37]

Do you have 2 sheets?
The activesheet and sheet1?
You must run the macro on the sheet that contains the data.

I attempted to run the the code again, and I still received the error rlv01 (Run-Time Error '9', Subscript Out of range). It appears the error pertains to the last portion of the code line.

Dim TargetRows As Range
    For i = LBound(RowArr) To LBound(RowArr) + Size
        If TargetRows Is Nothing Then
            Set TargetRows = ActiveSheet.Rows(RowArr(i))
        Else
          Set TargetRows = Union(TargetRows, ActiveSheet.Rows(RowArr(i)))
        End If
    Next i

It would seem the portion of code "Set TargetRows = Union(TargetRows, ActiveSheet.Rows(RowArr(i)))" is the cause of the error. When I run the full code I receive the following error:
Run-time error '1004':
This selection isn't valid. Make sure the copy and paste areas don't overlap unless they are the same size and shape.
The copied records are supposed to paste on to the new sheet. There is no previous data in the new sheet, so I'm not sure why it's giving me an overlap error.

 

[DanteAmor]

I did a test with some example data.
If you could share your file on google drive, maybe someone can download the file and check what the problem is.
If you have confidential data in your file you can replace it with generic data.
Remember to share your file, copy the link and paste here.

 

[Damian37]

I did a test with some example data.
If you could share your file on google drive, maybe someone can download the file and check what the problem is.
If you have confidential data in your file you can replace it with generic data.
Remember to share your file, copy the link and paste here.

I don't have access to google drive at work. My work computer blocks it. Is there any way I can upload a file here, or a different central location?

D.

 

[Damian37]

For that error, my testing matches what @DanteAmor said. If there is not data in at least the first two rows in column A, you get an error. If you have more data in column A and are still getting an error, then my guess would be that for some reason ActiveSheet.Rows(RowArr(i)) is not evaluating to a valid range. Use the VBE debugger to inspect variables to see what might cause that.

View attachment 100763

For errors, you should get into the habit of always providing certain information. For a runtime error you should report 3 things:

1. Error number
2. Error message
3. Line of code that generates the error.

So I'm still receiving this error, and when I hover over the highlighted line, the subscript out of range error comes up when I hover over the (RowArr(i)) section of the line. Am I not selecting an object at the beginning of the For statement? I feel in the beginning of this code I'm identifying the size, and then the For statement is the object. I just want to mention, there is data in the ActiveWorksheet, and I have placed that in the Set TargetRows section. Am I reading this wrong? Should I be placing the ActiveWorksheet within another area as well to create the object? Thanks for any help you can give me.

D.