Generate Random Groupings from List

Thread view:

Enable EMail Alerts

Start New Thread

Thread rating:

Nigel - 29 Jan 2007 04:37 GMT

This may be hard to do and a deck of cards may be my only answer

In Column A I have a list of names - potentially up to 32 (never any more)

What I need to be able to do is go thru that list and generate 4 even
groups, so for example if there were 20 names in the list it would generate 4
groups of 5 randomly picking the members for each group

The results for each group need to be placed in columns E,I,M,Q starting at
cell 1 in each coumn

If there are 19 people in the group then it would generate 3 of 5 and 1 of 4

Thanks for any assistance

Reply to this Message

merjet - 29 Jan 2007 07:32 GMT

Sub Shuffle()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim iCt As Integer
Dim iRow As Integer

Set ws1 = Worksheets("Sheet1") 'list of names in col A
Worksheets.Add after:=Worksheets(Worksheets.Count)
Set ws2 = Worksheets(Worksheets.Count)
iRow = ws1.Range("A1").End(xlDown).Row
ws1.Range("A1:A" & iRow).Copy Destination:=ws2.Range("A1")
ws2.Range("B1:B" & iRow).FormulaR1C1 = "=RAND()"
ws2.Range("A1:B" & iRow).Sort Key1:=ws2.Range("B1"), _
Order1:=xlAscending, Header:=xlGuess, OrderCustom:=1, _
MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
For iCt = 0 To 3
ws2.Range(Cells(5 * iCt + 1, 1), Cells(5 * iCt + 5, 1)).Copy _
Destination:=ws1.Cells(1, 5 + 4 * iCt)
Next iCt
Application.DisplayAlerts = False
Worksheets(Worksheets.Count).Delete
Application.DisplayAlerts = True
ws1.Activate
Set ws1 = Nothing
Set ws2 = Nothing
End Sub

Hth,
Merjet

Reply to this Message

Nigel - 29 Jan 2007 14:08 GMT

Thanks I get an error message at the line

> ws2.Range(Cells(5 * iCt + 1, 1), Cells(5 * iCt + 5, 1)).Copy _
> Destination:=ws1.Cells(1, 5 + 4 * iCt)

the message is "Method 'Range' of Object '_Worksheet' failed

> Sub Shuffle()
> Dim ws1 As Worksheet
[quoted text clipped - 26 lines]
> Hth,
> Merjet

Reply to this Message

Dave Peterson - 29 Jan 2007 14:44 GMT

Try qualifying those ranges:

ws2.Range(Cells(5 * iCt + 1, 1), Cells(5 * iCt + 5, 1)).Copy _
Destination:=ws1.Cells(1, 5 + 4 * iCt)

becomes

ws2.Range(ws2.Cells(5 * iCt + 1, 1), ws2.Cells(5 * iCt + 5, 1)).Copy _
Destination:=ws1.Cells(1, 5 + 4 * iCt)

> Thanks I get an error message at the line
>
[quoted text clipped - 33 lines]
> > Hth,
> > Merjet

Signature

Dave Peterson

Reply to this Message

Nigel - 29 Jan 2007 15:45 GMT

an you explain what this line is doing, I got the code to work but I am
trying to work out how many records it decides to take each time

Thanks

For iCt = 0 To 1

ws1.Range(Cells(5 * iCt + 1, 1), Cells(5 * iCt + 5, 1)).Copy _
Destination:=ws1.Cells(1, 5 + 4 * iCt)

Next iCt

> Sub Shuffle()
> Dim ws1 As Worksheet
[quoted text clipped - 26 lines]
> Hth,
> Merjet

Reply to this Message

Dave Peterson - 29 Jan 2007 15:59 GMT

After you've qualified the ranges(!)...

The first time through the loop (when iCt = 0), it's equivalent to:
ws1.range("A1:A5").copy _
destination:=ws1.Range("e1")

The second time through the loop (when iCt = 1), it's equivalent to:
ws1.range("A6:A10").copy _
destination:=ws1.Range("i1")

> an you explain what this line is doing, I got the code to work but I am
> trying to work out how many records it decides to take each time
[quoted text clipped - 38 lines]
> > Hth,
> > Merjet

Signature

Dave Peterson

Reply to this Message

Nigel - 29 Jan 2007 16:39 GMT

OK now I am gonna sound stupid, but what decides how lines to take, I am
doing a bit of modification that is basically if its 12 rows then split into
6,
if 13 to 18 then 3 groups of 6 and any more of that then spread equally
amonsgt 4 columns

> After you've qualified the ranges(!)...
>
[quoted text clipped - 48 lines]
> > > Hth,
> > > Merjet

Reply to this Message

merjet - 29 Jan 2007 17:15 GMT

The code I wrote in #2 was for your original specs. The number of
lines it takes is 5, which is hard-coded. If there are 19 names in the
list, it still takes 4 groups of 5. The last one is empty, so you
don't see it. If there were 18 names, the 4th group would get only 3.
The number of groups is also hard-coded to 4 by the '0 to 3' loop
parameters.

Your latest post implies different specs than your original ones. It
calls for potentially a different number of groups and a different
number of names in each one. Obviously that would require some more
flexible VBA code (less hard-coding).

Hth,
Merjet

Reply to this Message

Nigel - 29 Jan 2007 17:41 GMT

merjet,

I love the code and it worked fine, I was trying to modify it to make it a
little bit more flexible,

i got how the number of groups is done but what I am trying to work out is
what decides the length of the group,

ws1.Range(Cells(5 * iCt + 1, 1), Cells(5 * iCt + 5, 1)).Copy _
Destination:=ws1.Cells(1, 5 + 4 * iCt)

so fr example if I wanted 2 groups of 6 (in the case of 12 people I would
change

For ict=0 to 3

to For ict= 0 to 1

just not sure how to make it get 6 rows only

thanks

> The code I wrote in #2 was for your original specs. The number of
> lines it takes is 5, which is hard-coded. If there are 19 names in the
[quoted text clipped - 10 lines]
> Hth,
> Merjet

Reply to this Message

merjet - 29 Jan 2007 18:00 GMT

> so fr example if I wanted 2 groups of 6 (in the case of 12 people I would
> change
[quoted text clipped - 4 lines]
>
> just not sure how to make it get 6 rows only

That correct for the loop. To get 6 rows change the 5's to 6's:
ws1.Range(Cells(6 * iCt + 1, 1), Cells(6 * iCt + 6, 1)).Copy _
Destination:=ws1.Cells(1, 6 + 4 * iCt)

Maybe earlier in the code you should put some Select Case Statements
to calculate the number of groups and number of names in each based on
the total number of names.

Hth,
Merjet

Reply to this Message

Nigel - 29 Jan 2007 18:21 GMT

thats how I am doing that, using an if statement on number of rows then
decide how many to put in each group

it would be nice to set it for example if there are 19 people 2 groups of 6
and 1 of 7, but this will do exactly what I need to do as I can copy from one
list to another to correct

> > so fr example if I wanted 2 groups of 6 (in the case of 12 people I would
> > change
[quoted text clipped - 15 lines]
> Hth,
> Merjet

Reply to this Message