Have Excel grab (somewhat) random rows

[FrumpyJones]

Hi Everyone. So I have data (say 500 rows). The data is broken up by persons, and what I want excel to do is ultimately grab a random sample of rows from each person (Let's say 5) and that the samples for each person must be at least two away from the previous one. In the real world there will be a random number of rows (But greater than 10) for each person. annnnnd copy all of those random selections into a new tab (or delete the rows not selected... whichever is easier). Thanks in advance for you help on this one. Data kinda looks like this (Name will always be in column A):

Name	Data blah blah	more data blah blah
Charlie	stuff 1	more stuff 1
Charlie	stuff 2	more stuff 2
Charlie	etc	etc
Charlie
Charlie
Charlie
Debbie
Debbie
Debbie
Debbie
Debbie
Debbie

<tbody>
</tbody>

 

[FrumpyJones]

Hi @baitmaster,

I ran the code against a list of 254 rows with 11 unique names in the names column.

Code ran fine (thank you), but the end result was 127 rows with various amounts of rows per person (ranging from 9 to 14).

Is there a way to limit the amount of results per person to 5?

*****EDIT*****

I somehow missed the integer At the very top.... Changed it to 5. Works like a champ!

THANK YOU!

 

[baitmaster]

Sorry I did that, but then changed the limit during testing to ensure the code didn't enter a terminal loop if there weren't enough samples to create 5 unique values, and forgot to change it back!

Amend this line to read 5

Const iSamples As Integer = 21

 

[FrumpyJones]

Hi once more @baitmaster,

The code works great, I've run it against several different data sets and it's working perfectly.

One final question about this code:

Is there a way to have it replace the data it's actually reading from? That is, to delete the original data and post the result set over the data it read from? It's fine if it doesn't but can remove an extra step I'd have to explain to the rest of my team.

Thanks again for your code.

 

[baitmaster]

Yes, in VBA anything is possible

All the results are stored in an array, which I'm currently choosing to pass to a new file so I don't interfere with the existing data

I could just as easily wipe out the contents of Sheet1 and paste the array there instead. Something like replacing

Dim wb As WorkbookSet wb = Workbooks.Add
wb.Sheets(1).Range("A1").Resize(UBound(arrResults, 2) - LBound(arrResults, 2) + 1, UBound(arrResults, 1) - LBound(arrResults, 1) + 1).Value = Application.Transpose(arrResults)

with

Sheet1.usedrange.clear
Sheet1.Range("A1").Resize(UBound(arrResults, 2) - LBound(arrResults, 2) + 1, UBound(arrResults, 1) - LBound(arrResults, 1) + 1).Value = Application.Transpose(arrResults)

 

[FrumpyJones]

@baitmaster,

We are so >< that close to having this be my dream come true. The code you replaced actually wiped EVERYTHING. All my formatting, header rows, nice green and light green table layout, etc, and replaced it with the data from the array.

Can we have it just delete the values from say a2-a500 and b2-b500 and ignore formatting and whatnot? We should never have a result set that large (My fancy good looking table only goes to 300), but it would just cover all bases

 

[baitmaster]

Yes, it clears everything in the Usedrange = the entire worksheet, sorry if that wasn't clear. Good job I disclaim that in my signature eh?

You just have to amend the range object that you want to clear. This can be a fixed range of cells e.g. Sheet1.Range("A1:B500"), or say the currentregion = any cell within the rectangular block of cells that is directly linked to a specific cell e.g. Sheet1.Range("A1").CurrentRegion. Or you could use Sheet1.Range("A1")).End(xlDown) to find the last cell in the contiguous range of cells in that column, there's many ways to do this - if you can think of it, VBA can do it

 

[FrumpyJones]

@baitmaster,

But what could I use to just delete the data, and not the formatting?

 

[FrumpyJones]

I DID IT MYSELF *Claps and jumps for himself*.

ClearContents!

I can do things!

Thanks again for all your help, @baitmaster !

 

[FrumpyJones]

3+ years later and I needed to do this again... But had lost the original to many laptops ago. Thanks again @baitmaster !