Extracting number from a range randomly

[Goalexcel]

Hello Expert, please kindly advise what is the best method to extract numbers from a range randomly
I have a series of numbers in the range of A1 to T16. I would like to extract 3 differents numbers from each columns, and place them in column A21, B21so on. I wonder. if there is a way to do that easily.

 

[Peter_SSs]

See if this is what you need.

21 01 14.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S
1	4962	1656	8770	440	9157	9841	1849	4091	7804	1294	5446	2912	2279	2457	6396	6920	287	6576	6779
2	4879	4298	5200	3776	7455	7950	2360	2232	7639	3966	2906	1942	921	3881	701	9795	257	7750	7906
3	2377	3071	723	2875	7295	8489	4397	4226	4905	7297	5461	4565	3375	6702	2878	9053	6629	1454	9166
4	8000	9256	6542	9430	1441	8086	2150	4684	6111	6464	6157	8685	5026	6055	4467	3260	7334	4495	7391
5	3752	801	4814	5463	4046	2027	79	5379	3717	5699	4184	8336	7781	2542	596	4172	3269	9959	2078
6	254	3733	8736	2593	2035	8981	6276	2866	8765	9777	2021	4253	2790	1031	4741	3732	3860	4231	7284
7	6504	373	8648	7885	3700	964	1636	1508	6762	5555	953	7294	9501	647	2628	3499	5879	4148	3619
8	425	3297	3839	3264	8525	1317	8081	6458	8751	1000	5054	2401	6900	2478	4228	2968	7076	1472	496
9	9375	1434	6976	2129	4513	7341	1098	8000	9650	5276	1730	3436	5150	2572	6468	3143	8367	7064	1390
10	2693	5433	6616	2896	2164	8548	8022	8112	106	7607	4870	1520	8744	9880	5406	5646	5171	5592	4264
11	5590	7445	585	3775	8234	1552	4087	3704	725	7941	7941	2272	8309	4554	4655	2469	3624	1457	4190
12	5723	7622	2586	4168	657	3457	317	2357	7598	8936	1963	5691	6829	538	2068	2070	8482	456	9517
13	6903	9384	7153	9963	3164	436	8620	5260	7506	5775	5997	4628	9700	2291	2344	3433	7571	1970	596
14	1269	1436	1821	9331	6941	4097	5358	8797	7261	360	8859	4276	9748	4585	3101	3210	3822	2165	6863
15	8855	6653	146	9681	9015	2913	2149	5368	263	995	938	4871	7115	6705	6083	5003	2487	3002	2973
16	6826	3583	2709	9053	4635	5682	5896	8453	828	3546	3306	6719	5220	870	5878	2950	5230	5314	5074
17
18
19
20
21	5590	5433	6542	2129	9015	3457	1849	3704	8751	6464	953	3436	9700	3881	4467	2070	8482	1472	7906
22	3752	9384	2709	2593	6941	7950	317	2866	7506	7607	4184	2912	2790	647	6396	4172	3860	456	7284
23	425	3071	585	2896	7295	2027	4087	5379	7639	3966	1730	2272	5026	4554	4228	9795	3269	3002	496
Extract 3 Random

Cell Formulas
Range	Formula
A21:S23	A21	=INDEX(A$1:A$16,AGGREGATE(15,6,((ROW(A$1:A$16)-ROW(A$1)+1)/ISNA(MATCH(A$1:A$16,A$20:A20,0))),RANDBETWEEN(1,ROWS(A$1:A$16)-COUNT(A$20:A20))))

 

[aRandomHelper]

VBA solution that can work if some cells contain same info:

Sub pickRand()
    Dim i As Long, ss As String, r As Long, s As Boolean, c As Long, v
    Randomize
    Application.ScreenUpdating = False
    With ActiveSheet
        For i = 1 To 20 '20 columns = A:T, expand as you wish
            ss = ""
            s = False
            c = 0
            Do
                r = CLng(((Rnd * 1000000) Mod 16)) + 1
                If ss <> "" Then
                    If InStr(ss, CStr(r)) <= 0 Then
                        ss = ss & "," & r
                        s = True
                        c = c + 1
                    End If
                Else
                    ss = r
                    s = True
                    c = c + 1
                End If
            Loop While s = False Or (s = True And c < 3) '3 = number of random cells to pick
            v = Split(ss, ",")
            For c = LBound(v) To UBound(v)
                .Cells(21 + c, i).Value = .Cells(v(c), i).Value '21 = starting row to output selected cells
            Next
        Next
    End With
    Application.ScreenUpdating = True
End Sub

 

[Goalexcel]

VBA solution that can work if some cells contain same info:

Sub pickRand()
    Dim i As Long, ss As String, r As Long, s As Boolean, c As Long, v
    Randomize
    Application.ScreenUpdating = False
    With ActiveSheet
        For i = 1 To 20 '20 columns = A:T, expand as you wish
            ss = ""
            s = False
            c = 0
            Do
                r = CLng(((Rnd * 1000000) Mod 16)) + 1
                If ss <> "" Then
                    If InStr(ss, CStr(r)) <= 0 Then
                        ss = ss & "," & r
                        s = True
                        c = c + 1
                    End If
                Else
                    ss = r
                    s = True
                    c = c + 1
                End If
            Loop While s = False Or (s = True And c < 3) '3 = number of random cells to pick
            v = Split(ss, ",")
            For c = LBound(v) To UBound(v)
                .Cells(21 + c, i).Value = .Cells(v(c), i).Value '21 = starting row to output selected cells
            Next
        Next
    End With
    Application.ScreenUpdating = True
End Sub

Thank you very much for your help and support. Can you please, modify the macro, in A1:T I have titles. Also , after choose the random number from the table, need to be checked or color the cells that contained the numbers that had been choosing, in order to control the duplicates every time we do the macro randomly.

 

[Goalexcel]

See if this is what you need.

21 01 14.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S
1	4962	1656	8770	440	9157	9841	1849	4091	7804	1294	5446	2912	2279	2457	6396	6920	287	6576	6779
2	4879	4298	5200	3776	7455	7950	2360	2232	7639	3966	2906	1942	921	3881	701	9795	257	7750	7906
3	2377	3071	723	2875	7295	8489	4397	4226	4905	7297	5461	4565	3375	6702	2878	9053	6629	1454	9166
4	8000	9256	6542	9430	1441	8086	2150	4684	6111	6464	6157	8685	5026	6055	4467	3260	7334	4495	7391
5	3752	801	4814	5463	4046	2027	79	5379	3717	5699	4184	8336	7781	2542	596	4172	3269	9959	2078
6	254	3733	8736	2593	2035	8981	6276	2866	8765	9777	2021	4253	2790	1031	4741	3732	3860	4231	7284
7	6504	373	8648	7885	3700	964	1636	1508	6762	5555	953	7294	9501	647	2628	3499	5879	4148	3619
8	425	3297	3839	3264	8525	1317	8081	6458	8751	1000	5054	2401	6900	2478	4228	2968	7076	1472	496
9	9375	1434	6976	2129	4513	7341	1098	8000	9650	5276	1730	3436	5150	2572	6468	3143	8367	7064	1390
10	2693	5433	6616	2896	2164	8548	8022	8112	106	7607	4870	1520	8744	9880	5406	5646	5171	5592	4264
11	5590	7445	585	3775	8234	1552	4087	3704	725	7941	7941	2272	8309	4554	4655	2469	3624	1457	4190
12	5723	7622	2586	4168	657	3457	317	2357	7598	8936	1963	5691	6829	538	2068	2070	8482	456	9517
13	6903	9384	7153	9963	3164	436	8620	5260	7506	5775	5997	4628	9700	2291	2344	3433	7571	1970	596
14	1269	1436	1821	9331	6941	4097	5358	8797	7261	360	8859	4276	9748	4585	3101	3210	3822	2165	6863
15	8855	6653	146	9681	9015	2913	2149	5368	263	995	938	4871	7115	6705	6083	5003	2487	3002	2973
16	6826	3583	2709	9053	4635	5682	5896	8453	828	3546	3306	6719	5220	870	5878	2950	5230	5314	5074
17
18
19
20
21	5590	5433	6542	2129	9015	3457	1849	3704	8751	6464	953	3436	9700	3881	4467	2070	8482	1472	7906
22	3752	9384	2709	2593	6941	7950	317	2866	7506	7607	4184	2912	2790	647	6396	4172	3860	456	7284
23	425	3071	585	2896	7295	2027	4087	5379	7639	3966	1730	2272	5026	4554	4228	9795	3269	3002	496
Extract 3 Random

Cell Formulas
Range	Formula
A21:S23	A21	=INDEX(A$1:A$16,AGGREGATE(15,6,((ROW(A$1:A$16)-ROW(A$1)+1)/ISNA(MATCH(A$1:A$16,A$20:A20,0))),RANDBETWEEN(1,ROWS(A$1:A$16)-COUNT(A$20:A20))))

Thank you very much for your help. I've been looking long time , amazing , wow.

 

[aRandomHelper]

Sub pickRand()
    Dim i As Long, ss As String, r As Long, s As Boolean, c As Long, v
    Randomize
    Application.ScreenUpdating = False
    With ActiveSheet
        .Range("A20:T20").Value = .Range("A1:T1").Value
        For i = 1 To 20 '20 columns = A:T, expand as you wish
            ss = ""
            s = False
            c = 0
            Do
                r = CLng(((Rnd * 1000000) Mod 16)) + 2 ' +2 since you have a header row.
                If ss <> "" Then
                    If InStr(ss, CStr(r)) <= 0 Then
                        ss = ss & "," & r
                        s = True
                        c = c + 1
                    End If
                Else
                    ss = r
                    s = True
                    c = c + 1
                End If
            Loop While s = False Or (s = True And c < 3) '3 = number of random cells to pick
            v = Split(ss, ",")
            For c = LBound(v) To UBound(v)
                .Cells(21 + c, i).Value = .Cells(v(c), i).Value '21 = starting row to output selected cells
                .Cells(v(c), i).Interior.Color = vbYellow
            Next
        Next
    End With
    Application.ScreenUpdating = True
End Sub

 

[Goalexcel]

Sub pickRand()
    Dim i As Long, ss As String, r As Long, s As Boolean, c As Long, v
    Randomize
    Application.ScreenUpdating = False
    With ActiveSheet
        .Range("A20:T20").Value = .Range("A1:T1").Value
        For i = 1 To 20 '20 columns = A:T, expand as you wish
            ss = ""
            s = False
            c = 0
            Do
                r = CLng(((Rnd * 1000000) Mod 16)) + 2 ' +2 since you have a header row.
                If ss <> "" Then
                    If InStr(ss, CStr(r)) <= 0 Then
                        ss = ss & "," & r
                        s = True
                        c = c + 1
                    End If
                Else
                    ss = r
                    s = True
                    c = c + 1
                End If
            Loop While s = False Or (s = True And c < 3) '3 = number of random cells to pick
            v = Split(ss, ",")
            For c = LBound(v) To UBound(v)
                .Cells(21 + c, i).Value = .Cells(v(c), i).Value '21 = starting row to output selected cells
                .Cells(v(c), i).Interior.Color = vbYellow
            Next
        Next
    End With
    Application.ScreenUpdating = True
End Sub

Thank you a lot, works perfect, smooth, fast, saving a lot time. Excellent choice. Amazing , wow!!!

 

[Peter_SSs]

Thank you a lot, works perfect

I beg to differ.
The choices with that code are not truly random. For example if the first number chosen in a column happens to be, say, row 16 in the worksheet then it is then impossible for the number from row 6 in the sheet to also be chosen for that column. The error is with the InStr line in the code.

And another (less important) point:
You will likely never actually notice but the code is also somewhat inefficient in its choosing of the 'next' random value for r since it picks a value and then checks (sometimes incorrectly as I pointed out above) to see if that number has already been chosen. If it has it repeats that process until a suitable random value is chosen. In theory it could get caught up picking an already used value 5 or 10 or 10000 times before choosing a suitable one.

To demonstrate my first point above I altered the suggested code to ensure that row 16 was chosen first in every column as follows

Else
    ss = r
    ss = 16

I then ran the code several times without clearing the yellow colour and this is the result. You see that row 6 has never been chosen

Goalexcel.xlsm
	A	B	C	D	E	F	G	H	I	J
1	Sect 1	Sect 2	Sect 3	Sect 4	Sect 5	Sect 6	Sect 7	Sect 8	Sect 9	Sect 10
2	1101	1117	1133	1149	1165	1181	1197	1213	1229	1245
3	1102	1118	1134	1150	1166	1182	1198	1214	1230	1246
4	1103	1119	1135	1151	1167	1183	1199	1215	1231	1247
5	1104	1120	1136	1152	1168	1184	1200	1216	1232	1248
6	1105	1121	1137	1153	1169	1185	1201	1217	1233	1249
7	1106	1122	1138	1154	1170	1186	1202	1218	1234	1250
8	1107	1123	1139	1155	1171	1187	1203	1219	1235	1251
9	1108	1124	1140	1156	1172	1188	1204	1220	1236	1252
10	1109	1125	1141	1157	1173	1189	1205	1221	1237	1253
11	1110	1126	1142	1158	1174	1190	1206	1222	1238	1254
12	1111	1127	1143	1159	1175	1191	1207	1223	1239	1255
13	1112	1128	1144	1160	1176	1192	1208	1224	1240	1256
14	1113	1129	1145	1161	1177	1193	1209	1225	1241	1257
15	1114	1130	1146	1162	1178	1194	1210	1226	1242	1258
16	1115	1131	1147	1163	1179	1195	1211	1227	1243	1259
17	1116	1132	1148	1164	1180	1196	1212	1228	1244	1260
18
19
20	Sect 1	Sect 2	Sect 3	Sect 4	Sect 5	Sect 6	Sect 7	Sect 8	Sect 9	Sect 10
21	1115	1131	1147	1163	1179	1195	1211	1227	1243	1259
22	1108	1122	1142	1158	1165	1190	1203	1225	1244	1245
23	1106	1132	1135	1156	1175	1191	1197	1221	1236	1251
Sheet1

Here is an alternative code that addresses both of the above issues.
It also gives you an easy way to change if you wanted to pick other than 3 numbers from each column.
My code does assume that all the numbers in any single column are different as is the case with your sample.

Sub Pick_N()
  Dim d As Object
  Dim a As Variant, b As Variant
  Dim c As Long, i As Long, k As Long, uba As Long
 
  Const PickHowMany As Long = 3 '<- Edit to suit
 
  Randomize
  Application.ScreenUpdating = False
  Set d = CreateObject("Scripting.Dictionary")
  With Range("A2:T17")
    a = .Value
    uba = UBound(a)
    ReDim b(1 To PickHowMany, 1 To UBound(a, 2))
    For c = 1 To UBound(a, 2)
      d.RemoveAll
      For i = 1 To uba
        d(a(i, c)) = i
      Next i
      For i = 1 To PickHowMany
        k = 1 + Int(Rnd() * d.Count)
        b(i, c) = d.Keys()(k - 1)
        .Cells(d.Items()(k - 1), c).Interior.Color = vbYellow
        d.Remove b(i, c)
      Next i
    Next c
    Range("A20").Resize(, UBound(a, 2)).Value = .Rows(0).Value
    Range("A21").Resize(UBound(b), UBound(b, 2)).Value = b
  End With
  Application.ScreenUpdating = True
End Sub

 

[aRandomHelper]

The error is with the InStr line in the code.

Great catch, thanks! Initially used dictionary to code it, but thought maybe it wasn't necessary.

Switched back to using dictionary:

Sub pickRand()
    Dim i As Long, ss As String, r As Long, s As Boolean, c As Long, v, d
    Set d = CreateObject("scripting.dictionary")
    Randomize
    Application.ScreenUpdating = False
    With ActiveSheet
        .Range("A20:T20").Value = .Range("A1:T1").Value
        For i = 1 To 20 '20 columns = A:T, expand as you wish
            d.RemoveAll
            s = False
            c = 0
            Do
                r = CLng(((Rnd * 1000000) Mod 16)) + 2 ' +2 since you have a header row.
                If Not d.exists(r) Then
                    d(r) = 1
                    s = True
                    c = c + 1
                End If
            Loop While s = False Or (s = True And c < 3) '3 = number of random cells to pick
            c = 0
            For Each v In d.keys
                .Cells(21 + c, i).Value = .Cells(CInt(v), i).Value '21 = starting row to output selected cells
                .Cells(CInt(v), i).Interior.Color = vbYellow
                c = c + 1
            Next
        Next
    End With
    Application.ScreenUpdating = True
End Sub

 

[Goalexcel]

I beg to differ.
The choices with that code are not truly random. For example if the first number chosen in a column happens to be, say, row 16 in the worksheet then it is then impossible for the number from row 6 in the sheet to also be chosen for that column. The error is with the InStr line in the code.

As another les important point:
You will likely never actually notice but the code is also somewhat inefficient in its choosing of the 'next' random value for r since it picks a value and then checks (sometimes incorrectly as I pointed out above) to see if that number has already been chosen. If it has it repeats that process until a suitable random value is chosen. In theory it could get caught up picking an already used value 5 or 10 or 10000 times before choosing a suitable one.

To demonstrate my first point above I altered the suggested code to ensure that row 16 was chosen first in every column as follows

Else
    ss = r
    ss = 16

I then ran the code several times without clearing the yellow colour and this is the result. You see that row 6 has never been chosen

Goalexcel.xlsm
	A	B	C	D	E	F	G	H	I	J
1	Sect 1	Sect 2	Sect 3	Sect 4	Sect 5	Sect 6	Sect 7	Sect 8	Sect 9	Sect 10
2	1101	1117	1133	1149	1165	1181	1197	1213	1229	1245
3	1102	1118	1134	1150	1166	1182	1198	1214	1230	1246
4	1103	1119	1135	1151	1167	1183	1199	1215	1231	1247
5	1104	1120	1136	1152	1168	1184	1200	1216	1232	1248
6	1105	1121	1137	1153	1169	1185	1201	1217	1233	1249
7	1106	1122	1138	1154	1170	1186	1202	1218	1234	1250
8	1107	1123	1139	1155	1171	1187	1203	1219	1235	1251
9	1108	1124	1140	1156	1172	1188	1204	1220	1236	1252
10	1109	1125	1141	1157	1173	1189	1205	1221	1237	1253
11	1110	1126	1142	1158	1174	1190	1206	1222	1238	1254
12	1111	1127	1143	1159	1175	1191	1207	1223	1239	1255
13	1112	1128	1144	1160	1176	1192	1208	1224	1240	1256
14	1113	1129	1145	1161	1177	1193	1209	1225	1241	1257
15	1114	1130	1146	1162	1178	1194	1210	1226	1242	1258
16	1115	1131	1147	1163	1179	1195	1211	1227	1243	1259
17	1116	1132	1148	1164	1180	1196	1212	1228	1244	1260
18
19
20	Sect 1	Sect 2	Sect 3	Sect 4	Sect 5	Sect 6	Sect 7	Sect 8	Sect 9	Sect 10
21	1115	1131	1147	1163	1179	1195	1211	1227	1243	1259
22	1108	1122	1142	1158	1165	1190	1203	1225	1244	1245
23	1106	1132	1135	1156	1175	1191	1197	1221	1236	1251
Sheet1

Here is an alternative code that addresses both of the above issues.
It also gives you an easy way to change if you wanted to pick other than 3 numbers from each column.
My code does assume that all the numbers in any single column are different as is the case with your sample.

Sub Pick_N()
  Dim d As Object
  Dim a As Variant, b As Variant
  Dim c As Long, i As Long, k As Long, uba As Long

  Const PickHowMany As Long = 3 '<- Edit to suit

  Randomize
  Application.ScreenUpdating = False
  Set d = CreateObject("Scripting.Dictionary")
  With Range("A2:T17")
    a = .Value
    uba = UBound(a)
    ReDim b(1 To PickHowMany, 1 To UBound(a, 2))
    For c = 1 To UBound(a, 2)
      d.RemoveAll
      For i = 1 To uba
        d(a(i, c)) = i
      Next i
      For i = 1 To PickHowMany
        k = 1 + Int(Rnd() * d.Count)
        b(i, c) = d.Keys()(k - 1)
        .Cells(d.Items()(k - 1), c).Interior.Color = vbYellow
        d.Remove b(i, c)
      Next i
    Next c
    Range("A20").Resize(, UBound(a, 2)).Value = .Rows(0).Value
    Range("A21").Resize(UBound(b), UBound(b, 2)).Value = b
  End With
  Application.ScreenUpdating = True
End Sub

Thank you for your replay Mr. Peter. Please check the below link , excel file TestPicknumber

Transfer - Dropbox

Dropbox is a free service that lets you bring your photos, docs, and videos anywhere and share them easily. Never email yourself a file again!

www.dropbox.com

Could you please, check when we pick up numbers by second time, we no need to repeat the numbers. Also workbook have 6 worksheets, so the range is no the same, for that, everytime apply different sheet, result runtime error 9, subscript out of range.