Solved Excel Macro Random Rows

June 23, 2015 at 12:08:51
Specs: Windows XP
I ran into a post from DerbyDad03 that grabs a certain number of rows based on a percentage. I've edited it a bit to fit what I'm trying to accomplish, but have run into a dilemna. My question is, is there a way to have percRows equal a certain number of rows to pull? This number wouldn't be hard-coded but I would like percRows to refer to a cell to get this number. Thank you for any assistance provided.


Randomize 'Initialize Random number seed
Dim MyRows() As Integer    ' Declare dynamic array.
Dim numRows, percRows, nxtRow, nxtRnd, chkRnd, copyRow As Integer
    'ThisWorkbook.Sheets("Inventory").Activate
    Sheets.Add After:=Sheets(Sheets.Count)
    Sheets("Sheet1").Select
    Sheets("Sheet1").Name = "Temp"
        Sheets("Inventory").Range("A1:N1").Copy Sheets("Temp").Range("A1")
'Determine Number of Rows in Sheet1 Column A
  numRows = Sheets(2).Range("B" & Rows.Count).End(xlUp).Row
'Get 10% of that number
    percRows = numRows * 0.1
'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(2).Rows(MyRows(copyRow)).EntireRow.Cut _
     Destination:=Sheets(4).Cells(copyRow, 1).Offset(1)


See More: Excel Macro Random Rows

Report •


#1
June 23, 2015 at 12:24:11
✔ Best Answer
In it's simplest form you could use:

percRows = Range("$A$1")

While this should work great when A1 contains a number, things will go horribly wrong if A1 contains "Fred". ;-)

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


Report •

#2
June 24, 2015 at 07:33:57
Thanks for the response DerbyDad03, but for some reason it is not working correctly. It is pulling rows but not the amount stated in my referenced cell. The amount of number of rows it is pulling seems arbitrary. Does percRows need to be declared differently?

message edited by JasonB


Report •

#3
June 24, 2015 at 07:46:02
I found out why it wasn't pulling the correct amount according to referenced cell. Apparently it didn't like when I commented out this line.

'If MyRows(chkRnd) = nxtRnd Then GoTo getNew

When it is checking for duplicates, does it look at the entire row or does it just look at a specific column? If it just looks at a specific column, is there a way to make it ignore duplicates because it is possible for my data to have similar content is rows.


Report •

Related Solutions

#4
June 24, 2015 at 08:08:22
Well, I'm kind of operating at a disadvantage here.

First off, it does not appear that you posted a complete macro in your 1st post. I don't see a Sub name() line or an End Sub line. I don't see a Next instruction after this loop:

For copyRow = 1 To percRows

I see instructions like this that don't seem to really do anything useful:

Sheets.Add After:=Sheets(Sheets.Count)

I also don't know what sheet the code is looking at in order to retrieve the value from A1.

All of that makes it hard for me to troubleshoot your issue. The best I can do at this point is say this:

If I add a Sub name() and End Sub line, and add a Next instruction after the loop, the code seems to do what it is supposed to, as currently written. If I then change this line:

'Get 10% of that number
    percRows = numRows * 0.1

to this:

'Get number from ActiveSheet A1
    percRows = Range("$A$1")

the code will use that number for the following loop and copy that exact number of rows.

'Loop through Array, copying rows to Sheet2
  For copyRow = 1 To percRows

May I suggest that you take a look at the following How-To? The debugging techniques explained in that tutorial may help you figure out why your code is not doing what you expect it to do:

http://www.computing.net/howtos/sho...

message edited by DerbyDad03


Report •

#5
June 24, 2015 at 08:30:28
DerbyDad03,

I did get it to work. My problem was that I had commented out the following line.

If MyRows(chkRnd) = nxtRnd Then GoTo getNew

Thank You!

My final question is: When it is checking for duplicates, does it look at the entire row or does it just look at a specific column? If it just looks at a specific column, is there a way to make it ignore duplicates because it is possible for my data to have similar content is columns.

message edited by JasonB


Report •

#6
June 24, 2015 at 11:10:11
The code is not looking for duplicates of your data, it it looking for duplicate numbers when building the array of random Row numbers to move.

Let's say you have 100 rows of data (numRows) and that you want to move a random set of 10 of those rows. (percRows = 10)

The section that builds the array of row numbers (MyRows) will loop 10 times:

'Create Random numbers and fill array
     For nxtRow = 1 To percRows

Each time through the loop, this instruction will generate a random number (nxtRnd) between 1 and 100 (numRows):

'Generate Random number
      nxtRnd = Int((numRows) * Rnd + 1)

If we let the code simply generate 10 random numbers from 1 to 100, we could end up with an array that looks like this, which is really only 8 rows since 5 appears 3 times.

(12, 5, 7, 5, 24, 5, 78, 100, 2, 10)

To avoid this unpleasant situation, the code loops through the then-current array (which grows by 1 element each time through the "building" loop) after each a random number is created and checks to see if the number already exists. If a duplicate is found, the code bounces back up to getNew and creates a new random number, which it then checks against the existing elements in the array. This continues until no match is found.

'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

As soon as the code determines that the latest number (nxtRnd) doesn't already exist, it adds it to the array and goes back to the start of the build loop to create a new number.

'Add element if Random number is unique
      MyRows(nxtRow) = nxtRnd
     Next

Once the array contains a set of 10 unique numbers... e.g.

(12, 5, 7, 61, 24, 85, 78, 100, 2, 10)

...then the code loops through the array and moves the rows designated by each element in the array.

'Loop through Array, copying rows to Sheet2
  For copyRow = 1 To percRows
       
     Sheets(2).Rows(MyRows(copyRow)).EntireRow.Cut _
     Destination:=Sheets(4).Cells(copyRow, 1).Offset(1)

A few other things to consider:

1 - That last loop, which does the actual Cutting and Pasting uses the word "copy", when in reality it should be "cut" since that is what the instruction does. e.g. copyRow should become cutRow just to make the code clearer. It's just a variable name, so it won't make any difference in what the code does, it just makes reading the code a little easier since the variable name matches what is really being done.

2 - The same situation exist for the variable name "percRows". This was chosen because the original code was moving a percentage of the overall rows, not a fixed number. I would consider changing that variable name to something that matches what you are doing now, like maybe myNumRows or something like that.

3 - In all cases, you should make sure that you edit the comments for any code sections that you change to avoid confusion in the future. I find it very annoying when I am trying to figure out what a piece of code does and the comments don't match the instructions.

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


Report •


Ask Question