GratefullyDyed
New Member
- Joined
- Nov 26, 2016
- Messages
- 27
- Office Version
- 2021
- Platform
- Windows
Option Explicit
Sub RandomGroup()
Dim i&, r&, rng, s As String, s1 As String
rng = Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row).Value
Randomize
r = Int(Rnd * UBound(rng)) + 1
s = rng(r, 1) & ", "
For i = 2 To 13
Do
r = Int(Rnd * UBound(rng)) + 1
s1 = rng(r, 1) & ", "
Loop Until InStr(1, ", " & s, ", " & s1) = 0
s = s & s1
Next
Cells(Rows.Count, "C").End(xlUp).Offset(1, 0).Value = Left(s, Len(s) - 2)
Columns(3).AutoFit
End Sub
RandomGroup.xlsm | |||||
---|---|---|---|---|---|
A | B | C | |||
1 | Term 1 | ||||
2 | Term 2 | Term 2, Term 19, Term 10, Term 18, Term 11, Term 5, Term 6, Term 13, Term 4, Term 9, Term 16, Term 14, Term 12 | |||
3 | Term 3 | ||||
4 | Term 4 | ||||
5 | Term 5 | ||||
6 | Term 6 | ||||
7 | Term 7 | ||||
8 | Term 8 | ||||
9 | Term 9 | ||||
10 | Term 10 | ||||
11 | Term 11 | ||||
12 | Term 12 | ||||
13 | Term 13 | ||||
14 | Term 14 | ||||
15 | Term 15 | ||||
16 | Term 16 | ||||
17 | Term 17 | ||||
18 | Term 18 | ||||
19 | Term 19 | ||||
20 | Term 20 | ||||
Sheet1 |
Try with VBA
Alt-F11 to open VBA window, insert module then paste below code.
Hit F5 to run, or create a button on worksheet then assign macro to this code:
VBA Code:Option Explicit Sub RandomGroup() Dim i&, r&, rng, s As String, s1 As String rng = Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row).Value Randomize r = Int(Rnd * UBound(rng)) + 1 s = rng(r, 1) & ", " For i = 2 To 13 Do r = Int(Rnd * UBound(rng)) + 1 s1 = rng(r, 1) & ", " Loop Until InStr(1, ", " & s, ", " & s1) = 0 s = s & s1 Next Cells(Rows.Count, "C").End(xlUp).Offset(1, 0).Value = Left(s, Len(s) - 2) Columns(3).AutoFit End Sub
RandomGroup.xlsm
A B C 1 Term 1 2 Term 2 Term 2, Term 19, Term 10, Term 18, Term 11, Term 5, Term 6, Term 13, Term 4, Term 9, Term 16, Term 14, Term 12 3 Term 3 4 Term 4 5 Term 5 6 Term 6 7 Term 7 8 Term 8 9 Term 9 10 Term 10 11 Term 11 12 Term 12 13 Term 13 14 Term 14 15 Term 15 16 Term 16 17 Term 17 18 Term 18 19 Term 19 20 Term 20 Sheet1
Option Explicit
Sub RandomGroup()
Dim i&, j&, num&, r&, rng, s As String, s1 As String
rng = Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row).Value
num = 100 ' number of results. change it to what ever you need.
Randomize
Do
j = j + 1
r = Int(Rnd * UBound(rng)) + 1
s = rng(r, 1) & ", "
For i = 2 To 13
Do
r = Int(Rnd * UBound(rng)) + 1
s1 = rng(r, 1) & ", "
Loop Until InStr(1, ", " & s, ", " & s1) = 0
s = s & s1
Next
Cells(j + 1, "F").Value = Left(s, Len(s) - 2)
Loop Until j = num
Columns(6).AutoFit
End Sub
Thats awesome thank you!!Try again:
It dupplicate to,i.e, 100 lines
(in code: num=100 , then adjust to what ever)
VBA Code:Option Explicit Sub RandomGroup() Dim i&, j&, num&, r&, rng, s As String, s1 As String rng = Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row).Value num = 100 ' number of results. change it to what ever you need. Randomize Do j = j + 1 r = Int(Rnd * UBound(rng)) + 1 s = rng(r, 1) & ", " For i = 2 To 13 Do r = Int(Rnd * UBound(rng)) + 1 s1 = rng(r, 1) & ", " Loop Until InStr(1, ", " & s, ", " & s1) = 0 s = s & s1 Next Cells(j + 1, "F").Value = Left(s, Len(s) - 2) Loop Until j = num Columns(6).AutoFit End Sub
Actually that doesn't work. It just hangs my program. Tried it with a small number of 2. Still just hangs itTry again:
It dupplicate to,i.e, 100 lines
(in code: num=100 , then adjust to what ever)
VBA Code:Option Explicit Sub RandomGroup() Dim i&, j&, num&, r&, rng, s As String, s1 As String rng = Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row).Value num = 100 ' number of results. change it to what ever you need. Randomize Do j = j + 1 r = Int(Rnd * UBound(rng)) + 1 s = rng(r, 1) & ", " For i = 2 To 13 Do r = Int(Rnd * UBound(rng)) + 1 s1 = rng(r, 1) & ", " Loop Until InStr(1, ", " & s, ", " & s1) = 0 s = s & s1 Next Cells(j + 1, "F").Value = Left(s, Len(s) - 2) Loop Until j = num Columns(6).AutoFit End Sub
I made an edit to my comment you must not have seen. The issue was there wasnt enough data in column A and it broke the script. After I added more data to A it worked wellWhat is "num" value? still 100 or 1 milion?
Could you post current code and actual data in column A?