Solved (EXCEL VBA) i tried to loop a random copy rows to new sheets

April 6, 2017 at 04:12:29
Specs: Windows 10
I found this code, i think it work great,

Here is the solution given by DerbyDad03 :
Option Explicit
Sub Random20()
Randomize 'Initialize Random number seed
Dim MyRows() As Integer ' Declare dynamic array.
Dim numRows, percRows, nxtRow, nxtRnd, chkRnd, copyRow As Integer
'Determine Number of Rows in Sheet1 Column A
numRows = Sheets(1).Range("A" & Rows.Count).End(xlUp).Row
'Get 20% of that number
percRows = numRows * 0.2
'Allocate elements in Array
ReDim MyRows(percRows)
'Create Random numbers and fill array
For nxtRow = 1 To percRows
getNew:
'Generate Random number
nxtRnd = Int((numRows) * Rnd + 1)
'Loop through array, checking for Duplicates
For chkRnd = 1 To nxtRow
'Get new number if Duplicate is found
If MyRows(chkRnd) = nxtRnd Then GoTo getNew
Next
'Add element if Random number is unique
MyRows(nxtRow) = nxtRnd
Next
'Loop through Array, copying rows to Sheet2
For copyRow = 1 To percRows
Sheets(1).Rows(MyRows(copyRow)).EntireRow.Copy _
Destination:=Sheets(2).Cells(copyRow, 1)
Next
End Sub

however, i would like to loop this code 10 times into 10 different sheets.

I tried putting this between the "loop vba" offered in MSDN, however it does not work.
Please help. Thank you so much in advance,


See More: (EXCEL VBA) i tried to loop a random copy rows to new sheets

Report •

✔ Best Answer
April 7, 2017 at 06:32:32
I do not have access to DropBox from my present location, so I can not access your workbook. However, I was able to duplicate the error with large data sets in my own workbook. 1000 Rows x 100 Columns, resulting in 800 rows in each sheet. I did get the Application error.

The following fix seems to have worked. On my machine, the code can take as long as 45 seconds to complete, and VBA may say "Not Responding", but it eventually finishes.

Try using the following Dim statements. They worked for me.

I'm not sure which variables were causing the problem so I Dimmed them all as Long. If you want to try and narrow it down, feel free.

Dim MyRows() As Long
Dim numRows As Long, percRows As Long, nxtRow As Long, _
    nxtRnd As Long, chkRnd As Long, sht As Long, copyRow As Long

Click Here Before Posting Data or VBA Code ---> How To Post Data or Code.

message edited by DerbyDad03



#1
April 6, 2017 at 04:53:09
Please click on the following line and read the instructions on how to post VBA code in this forum. Then repost the code using the pre tags so that it retains it original formatting. Thanks!

Click Here Before Posting Data or VBA Code ---> How To Post Data or Code.


Report •

#2
April 6, 2017 at 05:30:53
Dear DerbyDad03,
im sorry, was kinda rushed.
Here is the code

Option Explicit
Sub Random20()
Randomize 'Initialize Random number seed
Dim MyRows() As Integer    ' Declare dynamic array.
Dim numRows, percRows, nxtRow, nxtRnd, chkRnd, copyRow As Integer
'Determine Number of Rows in Sheet1 Column A
  numRows = Sheets(1).Range("A" & Rows.Count).End(xlUp).Row
'Get 20% of that number
   percRows = numRows * 0.2
'Allocate elements in Array
    ReDim MyRows(percRows) 
'Create Random numbers and fill array
     For nxtRow = 1 To percRows
getNew:
'Generate Random number
      nxtRnd = Int((numRows) * Rnd + 1)
'Loop through array, checking for Duplicates
       For chkRnd = 1 To nxtRow
'Get new number if Duplicate is found
        If MyRows(chkRnd) = nxtRnd Then GoTo getNew
       Next
'Add element if Random number is unique
      MyRows(nxtRow) = nxtRnd
     Next
'Loop through Array, copying rows to Sheet2
  For copyRow = 1 To percRows
   Sheets(1).Rows(MyRows(copyRow)).EntireRow.Copy _
     Destination:=Sheets(2).Cells(copyRow, 1)
  Next
End Sub

message edited by trungng2006


Report •

#3
April 6, 2017 at 07:23:39
Thanks for the re-post.

The current code copies Rows from Sheets(1) to Sheets(2) via this instruction. Note the Destination.

   Sheets(1).Rows(MyRows(copyRow)).EntireRow.Copy _
     Destination:=Sheets(2).Cells(copyRow, 1)

Assuming you want to copy random Rows from Sheets(1) to Sheets 2- 11, you could use a variable, e.g. sht, in a For-Next loop to loop through the sheets and also change that instruction to read:

   Sheets(1).Rows(MyRows(copyRow)).EntireRow.Copy _
     Destination:=Sheets(sht).Cells(copyRow, 1)

My other assumption is that you want a different set of random rows in each sheet. Therefore, I started the loop before the array of random rows is created. If you want the same set of random rows in each sheet, just start the loop before the section that does the copying since the array of random rows will already have been built by that time.

Try this:

Option Explicit
Sub Random20()
Randomize 'Initialize Random number seed
Dim MyRows() As Integer    ' Declare dynamic array.
Dim numRows, percRows, nxtRow, nxtRnd, chkRnd, sht, copyRow As Integer
'Determine Number of Rows in Sheet1 Column A
  numRows = Sheets(1).Range("A" & Rows.Count).End(xlUp).Row
'Get 20% of that number
   percRows = numRows * 0.2
'Allocate elements in Array
    ReDim MyRows(percRows)
'Loop through Sheets
 For sht = 2 To 11
'Create Random numbers and fill array
    For nxtRow = 1 To percRows
getNew:
'Generate Random number
      nxtRnd = Int((numRows) * Rnd + 1)
'Loop through array, checking for Duplicates
       For chkRnd = 1 To nxtRow
'Get new number if Duplicate is found
        If MyRows(chkRnd) = nxtRnd Then GoTo getNew
       Next
'Add element if Random number is unique
      MyRows(nxtRow) = nxtRnd
     Next
'Loop through Array, copying rows to Sheet(sht)
  For copyRow = 1 To percRows
   Sheets(1).Rows(MyRows(copyRow)).EntireRow.Copy _
     Destination:=Sheets(sht).Cells(copyRow, 1)
  Next
 Next
End Sub

Click Here Before Posting Data or VBA Code ---> How To Post Data or Code.

message edited by DerbyDad03


Report •

Related Solutions

#4
April 6, 2017 at 08:44:32
Thank you so much for the prompt reply,

I am really sorry, i think i am not being clear and wasted your time.
ex:
I have full samples in sheet1
For sheet 2-11 I need:
1.non-duplicated rows within the sheet
2.reloop with full sample from sheet 1 to new sheet (the some rows in sheet 2 can be use in sheet 3)

If this is your 1st assumption (we have the same understanding), then somehow it said that "script out of range"

Sheets(1).Rows(MyRows(copyRow)).EntireRow.Copy _
     Destination:=Sheets(sht).Cells(copyRow, 1)

This is my whole code:

Sub Random20()
Randomize 'Initialize Random number seed
Dim MyRows() As Integer    ' Declare dynamic array.
Dim numRows, percRows, nxtRow, nxtRnd, chkRnd, copyRow, sht As Integer
'Determine Number of Rows in Sheet1 Column A
  numRows = Sheets(1).Range("A" & Rows.Count).End(xlUp).Row
'Get 80% of that number
   percRows = numRows * 0.8
'Allocate elements in Array
    ReDim MyRows(percRows)
'Create Random numbers and fill array
     For nxtRow = 1 To percRows
getNew:
'Generate Random number
      nxtRnd = Int((numRows) * Rnd + 1)
'Loop through array, checking for Duplicates
       For chkRnd = 1 To nxtRow
'Get new number if Duplicate is found
        If MyRows(chkRnd) = nxtRnd Then GoTo getNew
       Next
'Add element if Random number is unique
      MyRows(nxtRow) = nxtRnd
     Next
     'Loop through Sheets
 For sht = 2 To 11
 Next
'Loop through Array, copying rows to Sheet2
  For copyRow = 1 To percRows
   Sheets(1).Rows(MyRows(copyRow)).EntireRow.Copy _
     Destination:=Sheets(sht).Cells(copyRow, 1)
  Next
End Sub


Report •

#5
April 6, 2017 at 09:43:29
In your first post you said:

"I found this code, i think it work great"

The code you posted selects a random 20% of the rows in Sheet1 and copies them to Sheet2.

Now you say "For sheet 2-11 I need:
1.non-duplicated rows within the sheet
.

It is not clear to me what you mean by "non-duplicated" rows. Are you still looking for a random 20% of the rows from Sheet 1?

If so, are there duplicate rows in the main sample list? If not, there should be no duplicate rows on Sheet 2 because the code ensures that the same row is never chosen more than once.

If you do have duplicate rows in the main sample list, then it's possible to get duplicate rows on Sheet 2, not because the code chose the same row twice, but because it just happened to (randomly) grab a row with the same data as another row i.e. a "duplicate". That can be fixed, but I'm not going to work on that until I understand what you are trying to do.

As far as your error, that is being caused by how you modified the code.

You did this. Note where you put the For-Next loop for sht.

'Loop through Sheets
 For sht = 2 To 11 '<------------
 Next              '<------------
'Loop through Array, copying rows to Sheet2
  For copyRow = 1 To percRows
   Sheets(1).Rows(MyRows(copyRow)).EntireRow.Copy _
     Destination:=Sheets(sht).Cells(copyRow, 1)
  Next

You started it and ended it before any work is done. The only thing that loop does is count from 1 to 12. In order for the loop to do repeat a task multiple times, there needs to be instructions between the For and the Next.

Once your loop is done doing nothing but counting, the variable sht is equal to 12. Then when the variable is used in Destination:=Sheets(sht) the code is looking for Sheet(12) which I assume doesn't exist. If VBA code tries to access an Excel object that doesn't exist, it throws out a Subscript Out Of Range error.

You need to move the Next for the sht loop to after the loop that copies the rows so that the copy instruction is executed each time the loop counts.

'Loop through Sheets
 For sht = 2 To 11 '<------------

'Loop through Array, copying rows to Sheet2
  For copyRow = 1 To percRows
   Sheets(1).Rows(MyRows(copyRow)).EntireRow.Copy _
     Destination:=Sheets(sht).Cells(copyRow, 1)
  Next

 Next              '<------------

Important Note: The code does not create the sheets. It only copies rows from Sheet1 to other existing Sheets. If Sheets 1-11 do not exist, you will get the same Subscript Our Of Range error as soon as the code tries to access a non-existent sheet.

Click Here Before Posting Data or VBA Code ---> How To Post Data or Code.


Report •

#6
April 6, 2017 at 10:35:03
Dear DerbyDad03,
I am really grateful for the prompt reply and the crystal clear explanation.

I think we just have a little misunderstood.
"In your first post you said:
"I found this code, i think it work great"
The code you posted selects a random 20% of the rows in Sheet1 and copies them to Sheet2.
Now you say "For sheet 2-11 I need:
1.non-duplicated rows within the sheet.
It is not clear to me what you mean by "non-duplicated" rows. Are you still looking for a random 20% of the rows from Sheet 1?
If so, are there duplicate rows in the main sample list? If not, there should be no duplicate rows on Sheet 2 because the code ensures that the same row is never chosen more than once."
=> we are on the same page, sheet 1 have no duplicate rows
what i mean is for example
sheet1:(1,2,3,4,5,6,7,8,9,10)
i want to create for example 50% random rows:
sheet 2 (2,4,6,7,3)
sheet 3 (5,4,8,9,2)
=> Since 2 and 4 appear in both sheet 2 and sheet3, so no duplicate within a sheet, but there can be duplicate row between sheet

for my code revised which is

Option Explicit
Sub Random20()
Randomize 'Initialize Random number seed
Dim MyRows() As Integer    ' Declare dynamic array.
Dim numRows, percRows, nxtRow, nxtRnd, chkRnd, sht, copyRow As Integer
'Determine Number of Rows in Sheet1 Column A
  numRows = Sheets(1).Range("A" & Rows.Count).End(xlUp).Row
'Get 80% of that number
   percRows = numRows * 0.8
'Allocate elements in Array
    ReDim MyRows(percRows)
'Loop through Sheets
 For sht = 2 To 11
'Create Random numbers and fill array
    For nxtRow = 1 To percRows
getNew:
'Generate Random number
      nxtRnd = Int((numRows) * Rnd + 1)
'Loop through array, checking for Duplicates
       For chkRnd = 1 To nxtRow
'Get new number if Duplicate is found
        If MyRows(chkRnd) = nxtRnd Then GoTo getNew
       Next
'Add element if Random number is unique
      MyRows(nxtRow) = nxtRnd
     Next
'Loop through Array, copying rows to Sheet(sht)
  For copyRow = 1 To percRows
   Sheets(1).Rows(MyRows(copyRow)).EntireRow.Copy _
     Destination:=Sheets(sht).Cells(copyRow, 1)
  Next
 Next
End Sub

it worked, BUT sheet2-sheet11 is exactly the same

for your 2nd assumption in the #3 reply:

Option Explicit
Sub Random20()
Randomize 'Initialize Random number seed
Dim MyRows() As Integer    ' Declare dynamic array.
Dim numRows, percRows, nxtRow, nxtRnd, chkRnd, sht, copyRow As Integer
'Determine Number of Rows in Sheet1 Column A
  numRows = Sheets(1).Range("A" & Rows.Count).End(xlUp).Row
'Get 20% of that number
   percRows = numRows * 0.2
'Allocate elements in Array
    ReDim MyRows(percRows)
'Loop through Sheets
 For sht = 2 To 11
'Create Random numbers and fill array
    For nxtRow = 1 To percRows
getNew:
'Generate Random number
      nxtRnd = Int((numRows) * Rnd + 1)
'Loop through array, checking for Duplicates
       For chkRnd = 1 To nxtRow
'Get new number if Duplicate is found
        If MyRows(chkRnd) = nxtRnd Then GoTo getNew
       Next
'Add element if Random number is unique
      MyRows(nxtRow) = nxtRnd
     Next
'Loop through Array, copying rows to Sheet(sht)
  For copyRow = 1 To percRows
   Sheets(1).Rows(MyRows(copyRow)).EntireRow.Copy _
     Destination:=Sheets(sht).Cells(copyRow, 1)
  Next
 Next
End Sub

This work for sheet2, then error "application defined or object defined error" when i increase to 80% of the samples for each sheet
when i read the code, i think this code generate unique rows between sheets (ex:if rowA belong to sheet2, it cannot be in sheet 3).

message edited by trungng2006


Report •

#7
April 6, 2017 at 11:50:05
As far as I can tell, the only difference between the 2 macros that you posted in Response #6 is that the first one copies 80% of the rows and the second one copies 20%.

Assuming that is correct...

Regarding the first piece of code (80%), you appear to have said:

it worked, BUT sheet2-sheet11 is exactly the same

I pasted the code as is into the VBA editor and ran it against this data in Sheet1:

     A
1    1
2    2
3    3
4    4
5    5
6    6
7    7
8    8
9    9
10  10

In Sheet 2 I got:

     A
1    3
2    6
3    1
4    7
5    4
6    9
7   10
8    8

In Sheet 3 I got:

     A
1    4
2    5
3    3
4    1
5    2
6    7
7    9
8    6

In Sheet 4 I got:

     A
1    7
2    3
3    5
4    8
5    9
6    6
7   10
8    2

I could go on, but the point is that I got a different set of 8 values in each sheet.

I then pasted the second piece of code (20%) from your Response #6 into the VBA Editor. I changed the 0.2 to 0.8 and ran it.

I did not get any errors. I got a different set of 8 values in each sheet.

As far as I can tell, there is nothing wrong with either piece of code.

Perhaps there is an issue with your data, but that's not something I can see from where I am sitting.

Click Here Before Posting Data or VBA Code ---> How To Post Data or Code.


Report •

#8
April 6, 2017 at 20:40:16
Dear DerbyDad03,
You are correct, i opened a new file with new data, and it work very well.
I will check my data again.
Thank you so much for your help and guidance!

Update: this dataset i tried was only 160rows,

message edited by trungng2006


Report •

#9
April 7, 2017 at 00:44:02
I still have a problem with this dataset. I made sure there are no duplicate rows (because collumn A and B are unique).
I have also tried to revised the Cells into Range/rows, none of it work.
Could you help me to look into this file?
https://www.dropbox.com/s/3lucn02mt...


Update: This code does work IF there are equal or less than 190 rows. However, if there are more than 190 rows, then it will only random for sheet2, then show error sign.

message edited by trungng2006


Report •

#10
April 7, 2017 at 06:32:32
✔ Best Answer
I do not have access to DropBox from my present location, so I can not access your workbook. However, I was able to duplicate the error with large data sets in my own workbook. 1000 Rows x 100 Columns, resulting in 800 rows in each sheet. I did get the Application error.

The following fix seems to have worked. On my machine, the code can take as long as 45 seconds to complete, and VBA may say "Not Responding", but it eventually finishes.

Try using the following Dim statements. They worked for me.

I'm not sure which variables were causing the problem so I Dimmed them all as Long. If you want to try and narrow it down, feel free.

Dim MyRows() As Long
Dim numRows As Long, percRows As Long, nxtRow As Long, _
    nxtRnd As Long, chkRnd As Long, sht As Long, copyRow As Long

Click Here Before Posting Data or VBA Code ---> How To Post Data or Code.

message edited by DerbyDad03


Report •

#11
April 7, 2017 at 07:59:36
Thank you so much, it worked!!!!

However, the weird thing is when i changed back to Integer for all of the variables it also work.

Dim MyRows() As Integer
Dim numRows As Integer, percRows As Integer, nxtRow As Integer, _
    nxtRnd As Integer, chkRnd As Integer, sht As Integer, copyRow As Integer

Anyway, at least it work.
Thank you so much for your help!!!


Report •

#12
April 7, 2017 at 12:00:47
In the original code, I didn't dimension most of the variables as a specific data type, so they defaulted to "variant". It worked for the person I wrote it for, so I just left them like that.

It would be interesting to know which of those variables didn't work with the large data set when defaulted to the Variant type. Get back to me on that would you? ;-)

Click Here Before Posting Data or VBA Code ---> How To Post Data or Code.


Report •

#13
April 7, 2017 at 20:49:00
Sure, i would learn from this too.

However, I am quite new at this so let me make sure I understand what you are saying.
Like this?

Dim MyRows() As Integer ' Declare dynamic array.
Dim numRows, percRows, nxtRow, nxtRnd, chkRnd, copyRow As Integer

The numRows, percRows, nxtRow, nxtRnd, chkRnd are variant in this case? And you want me to test which one can be leave as this, and which one should be change to Integer?

message edited by trungng2006


Report •

#14
April 8, 2017 at 04:48:45
Yes, that is what I meant. I have 2 suggestions:

First, review this How-To. I think you will find it interesting and helpful.

https://www.computing.net/howtos/sh...

Second, since we know where the code is failing, you might be able to make some educated guesses about which variable(s?) might be causing the problems.

Click Here Before Posting Data or VBA Code ---> How To Post Data or Code.


Report •

#15
April 9, 2017 at 07:31:18
Dear DerbyDad03,

The problem is at the variable "nxtRow", other variables are ok as variant.

So the code run fine with:

Dim MyRows() As Integer 
Dim numRows, percRows, nxtRow As Integer, nxtRnd, chkRnd, sht, copyRow As Integer


Report •

#16
Report •

Ask Question