Separate drawn numbers and remaining numbers

[motilulla]

Hello,

Data column C:G, row3

Question is bit tricky I will try my best to explain it if any further query please let me know I will try again.
Separate drawn numbers and remaining numbers once cycle is completed restart again.

At initial stage 1 to 50 numbers were in pool
1st draw 13/02/2004 numbers drawn 16-29-32-36-41 I want drawn numbers to be placed separated by comma in J3 = 5 numbers & rest 50-5 = 45 numbers to be placed separated by comma in K3

2^nd draw 20-02-2004 numbers drawn 7-13-39-47-50 I want drawn numbers to be placed separated by comma in J4 = 10 numbers & rest 45-5 = 40 numbers to be placed separated by comma in K4

3^rd draw 27-02-2004 numbers drawn 14-18-19-31-37 I want drawn numbers to be placed separated by comma in J5 = 15 numbers & rest 40-5 = 35 numbers to be placed separated by comma in K5

4^th draw 05-03-2004 numbers drawn 4-7-33-37-39 (3 values are duplicates 7,37 & 39) I want drawn numbers to be placed separated by comma in J6 = 15+2 =17 numbers & rest 35-3 = 33 numbers to be placed separated by comma in K5

Once cycle is completed and all 1 to 50 numbers are drawn restart again all 50 is completed in J68 and K68 is empty

Restart from beginning in J69 as shown in example below

Book1
	A	B	C	D	E	F	G	H	I	J	K
1	Year	FECHA	n1	n2	n3	n4	n5			Drawn Numbers	Remaining Numbers
2	Year	FECHA	n1	n2	n3	n4	n5			Drawn Numbers	Remaining Numbers
3	2004	13/02/2004	16	29	32	36	41			16,29,32,36,41	1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,17,18,19,20,21,22,23,24,25,26,27,28,30,31,33,34,35,37,38,39,40,42,43,44,45,46,47,48,49,50
4	2004	20/02/2004	7	13	39	47	50			7,13,16,29,32,36,39,41,47,50	1,2,3,4,5,6,8,9,10,11,12,14,15,17,18,19,20,21,22,23,24,25,26,27,28,30,31,33,34,35,37,38,40,42,43,44,45,46,48,49
5	2004	27/02/2004	14	18	19	31	37			7,13,14,16,18,19,29,31,32,36,37,39,41,47,50	1,2,3,4,5,6,8,9,10,11,12,15,17,20,21,22,23,24,25,26,27,28,30,33,34,35,38,40,42,43,44,45,46,48,49
6	2004	05/03/2004	4	7	33	37	39			4,7,13,14,16,18,19,29,31,32,33,36,37,39,41,47,50	1,2,3,5,6,8,9,10,11,12,15,17,20,21,22,23,24,25,26,27,28,30,34,35,38,40,42,43,44,45,46,48,49
7	2004	12/03/2004	15	24	28	44	47
8	2004	19/03/2004	33	36	37	42	45
9	2004	26/03/2004	3	4	10	23	43
10	2004	02/04/2004	4	12	24	27	36
11	2004	09/04/2004	1	4	10	19	23
12	2004	16/04/2004	14	15	28	35	40
13	2004	23/04/2004	6	10	21	45	49
14	2004	30/04/2004	5	6	16	23	27
15	2004	07/05/2004	15	16	21	36	38
16	2004	14/05/2004	1	3	21	32	39
17	2004	21/05/2004	15	29	37	39	49
18	2004	28/05/2004	6	11	35	41	44
19	2004	04/06/2004	9	13	34	41	42
20	2004	11/06/2004	2	7	8	10	47
21	2004	18/06/2004	2	23	28	40	43
22	2004	25/06/2004	3	21	30	34	35
23	2004	02/07/2004	4	23	24	28	34
24	2004	09/07/2004	2	5	12	19	44
25	2004	16/07/2004	24	26	31	38	50
26	2004	23/07/2004	7	10	27	31	34
27	2004	30/07/2004	9	10	19	37	50
28	2004	06/08/2004	5	15	24	35	44
29	2004	13/08/2004	20	27	41	43	50
30	2004	20/08/2004	6	9	10	27	35
31	2004	27/08/2004	1	11	22	28	44
32	2004	03/09/2004	8	12	14	15	34
33	2004	10/09/2004	5	25	33	36	38
34	2004	17/09/2004	15	18	29	39	41
35	2004	24/09/2004	21	26	27	44	48
36	2004	01/10/2004	12	20	21	45	48
37	2004	08/10/2004	1	10	12	16	48
38	2004	15/10/2004	14	21	22	37	43
39	2004	22/10/2004	1	9	23	25	40
40	2004	29/10/2004	1	8	32	35	38
41	2004	05/11/2004	6	19	25	42	49
42	2004	12/11/2004	4	11	12	13	32
43	2004	19/11/2004	1	18	29	34	37
44	2004	26/11/2004	1	4	24	34	36
45	2004	03/12/2004	1	11	15	42	49
46	2004	10/12/2004	1	3	13	16	43
47	2004	17/12/2004	15	19	22	46	49
48	2004	24/12/2004	3	4	27	29	37
49	2004	31/12/2004	7	8	24	25	47
50	2005	07/01/2005	3	23	27	47	50
51	2005	14/01/2005	6	11	14	19	29
52	2005	21/01/2005	10	12	14	24	26
53	2005	28/01/2005	7	21	26	43	45
54	2005	04/02/2005	1	8	11	30	40
55	2005	11/02/2005	11	13	25	32	50
56	2005	18/02/2005	20	21	26	32	46
57	2005	25/02/2005	3	27	30	43	44
58	2005	04/03/2005	12	24	32	37	39
59	2005	11/03/2005	8	12	23	40	43
60	2005	18/03/2005	6	23	39	43	48
61	2005	25/03/2005	4	29	33	37	38
62	2005	01/04/2005	25	26	41	44	47
63	2005	08/04/2005	7	11	25	31	50
64	2005	15/04/2005	6	28	31	38	42
65	2005	22/04/2005	3	10	13	24	47
66	2005	29/04/2005	3	9	35	39	42
67	2005	06/05/2005	7	12	21	26	44
68	2005	13/05/2005	12	17	31	32	40			1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40,41,42,43,44,45,46,47,48,49,50
69	2005	20/05/2005	6	7	13	28	47			6,7,13,28,47	1,2,3,4,5,8,9,10,11,12,14,15,16,17,18,19,20,21,22,23,24,25,26,27,29,30,31,32,33,34,35,36,37,38,39,40,41,42,43,44,45,46,48,49,50
70	2005	27/05/2005	2	24	31	48	50
71	2005	03/06/2005	3	8	11	17	50
72	2005	10/06/2005	6	7	32	37	47
73	2005	17/06/2005	4	8	10	18	21
74	2005	24/06/2005	6	8	14	15	45
75	2005	01/07/2005	4	5	23	25	28
Sheet1

Thanks In Advance
Using version 2000

Regards,
Moti

 

[Ombir]

Try this:

Dim dict As Object
Sub motiulla()
Dim i       As Long
Dim j       As Long
Dim k       As Long
Dim n       As Long
Dim ar      As Variant
Dim list    As Object
Dim oar     As Variant

Set list = CreateObject("system.collections.arraylist")
Set dict = CreateObject("scripting.dictionary")
lr = Cells(Rows.Count, "C").End(xlUp).Row

ReDim oar(1 To lr, 1 To 2)
Call filldict

k = 1
For i = 3 To lr
    ar = Range("C" & i & ":G" & i)
    
    For j = 1 To UBound(ar, 2)
        If Not list.contains(ar(1, j)) Then
            list.Add ar(1, j)
            dict.Remove ar(1, j)
        End If
    Next
    
    list.Sort
    dra = Join(list.toarray, ",")
    Rmn = Join(dict.keys(), ",")
    oar(k, 1) = dra: oar(k, 2) = Rmn
    k = k + 1
    If dict.Count = 0 Then
        Call filldict
        list.Clear
    End If
Next
Range("J3").Resize(lr, 2) = oar
End Sub
Sub filldict()
dict.RemoveAll
For n = 1 To 50
    dict.Item(n) = vbEmpty
Next
End Sub

 

[kalak]

Like this perhaps. Results in columns N and O.

Sub moti2()

Const q As Long = 50
Dim a, b() As Boolean, u()
Dim i As Long, j As Long, n As Long
n = Cells(Rows.Count, "d").End(xlUp).Row
a = Range("D:H").Resize(n)
ReDim b(1 To q), u(1 To n, 1 To 2)

For i = 3 To n
    For j = 1 To 5
        If Not b(a(i, j)) Then b(a(i, j)) = True: c = c + 1
    Next j
    
    For j = 1 To q
        If b(j) Then u(i, 1) = u(i, 1) & "," & j Else u(i, 2) = u(i, 2) & "," & j
    Next j
    
    u(i, 1) = Mid(u(i, 1), 2)
    u(i, 2) = Mid(u(i, 2), 2)
    If c = q Then ReDim b(1 To q): c = 0
Next i

Range("N1").Resize(n, 2) = u
Range("N1").Resize(2, 2) = Array("Drawn Numbers", "Remaining Numbers")

End Sub

 

[motilulla]

Try this:

Dim dict As Object
Sub motiulla()
End Sub

Ombir, please can you check code stop at line below may be it is due to version I am using?

 Set list = CreateObject("system.collections.arraylist")

Thank you for your help

Regards,
Moti

 

[motilulla]

Like this perhaps. Results in columns N and O.

Sub moti2()
End Sub

Hello kalak,

Excellent code it is working flawless 100% prefect.

Thank you I appreciate your help

Regards,
Moti

 

[motilulla]

Hello,

Sorry for the inconvenience please require a modification to be analysed in detailed, could Drawn Numbers results can be separated in 50 cells from L3 to BI50 (Header L1:BI1 listed 1 To 50 Numbers) & Remaining Numbers can be separated in 50 cells from BK3 to DH50 (Header BK1:DH1 listed 1 To 50 Numbers)

Thank you

Regards,
Moti

 

[motilulla]

Hello,

L3 to BI50 (Header L1:BI1 listed 1 To 50 Numbers) & Remaining Numbers can be separated in 50 cells from
BK3 to DH50 (Header BK1:DH1 listed 1 To 50 Numbers)

Thank you

Regards,
Moti

Hello,

In post#6 I have typo error correct is L3:BI3 & BK3:DH3

Here also I want to clear Drawn Or Remaining number has to go in their header columns

For example first draw "drawn numbers 16,29,32,36,41" in range L3:BI3, 16 has to go AA3, 29 in AN3, 32 in AQ3, 36 in AU3 & 41 in AZ3. And the rest remaining numbers 45 in range BK3:DH3 in their corresponding header columns

Thank you

Regards,
Moti

 

[Ombir]

Ombir, please can you check code stop at line below may be it is due to version I am using?

 Set list = CreateObject("system.collections.arraylist")

Thank you for your help

Regards,
Moti

Hi,


I don't have Excel 2000 to test so I'm afraid I can't help. May be you've to provide reference to library containing Array List object. I searched but couldn't able to find the exact library name for this Object.

 

[motilulla]

Hi,

I don't have Excel 2000 to test so I'm afraid I can't help. May be you've to provide reference to library containing Array List object. I searched but couldn't able to find the exact library name for this Object.

Hello Ombir,

I appreciate a lot you efforts I found 2 links I do not know weather these link have any information about Excel version 2000.
https://msdn.microsoft.com/en-us/library/system.collections.arraylist(v=vs.110).aspx
https://msdn.microsoft.com/en-us/library/system.collections.arraylist.contains(v=vs.110).aspx

kalak, code is working perfect with scenario post#1.

Please can you take a look what I am looking now instead results output in single column
Split in 50 columns Drawn Results in cells L3:BI17,
Split in 50 columns Remaining Numbers results in cells BK3:DH17

Drawn Results new example sheet

Book1
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T	U	V	W	X	Y	Z	AA	AB	AC	AD	AE	AF	AG	AH	AI	AJ	AK	AL	AM	AN	AO	AP	AQ	AR	AS	AT	AU	AV	AW	AX	AY	AZ	BA	BB	BC	BD	BE	BF	BG	BH	BI
1	Year	FECHA	n1	n2	n3	n4	n5					1	2	3	4	5	6	7	8	9	10	11	12	13	14	15	16	17	18	19	20	21	22	23	24	25	26	27	28	29	30	31	32	33	34	35	36	37	38	39	40	41	42	43	44	45	46	47	48	49	50
2	Year	FECHA	n1	n2	n3	n4	n5					n1	n2	n3	n4	n5	n6	n7	n8	n9	n10	n11	n12	n13	n14	n15	n16	n17	n18	n19	n20	n21	n22	n23	n24	n25	n26	n27	n28	n29	n30	n31	n32	n33	n34	n35	n36	n37	n38	n39	n40	n41	n42	n43	n44	n45	n46	n47	n48	n49	n50
3	2004	13/02/2004	16	29	32	36	41																				16													29			32				36					41
4	2004	20/02/2004	7	13	39	47	50											7						13			16													29			32							39								47			50
5	2004	27/02/2004	14	18	19	31	37											7							14		16		18	19										29		31	32				36	37		39		41						47			50
6	2004	05/03/2004	4	7	33	37	39								4			7						13	14		16		18	19										29		31	32	33			36	37		39		41						47			50
7	2004	12/03/2004	15	24	28	44	47
8	2004	19/03/2004	33	36	37	42	45
9	2004	26/03/2004	3	4	10	23	43
10	2004	02/04/2004	4	12	24	27	36
11	2004	09/04/2004	1	4	10	19	23
12	2004	16/04/2004	14	15	28	35	40
13	2004	23/04/2004	6	10	21	45	49
14	2004	30/04/2004	5	6	16	23	27
15	2004	07/05/2004	15	16	21	36	38
16	2004	14/05/2004	1	3	21	32	39
17	2004	21/05/2004	15	29	37	39	49
Sheet1-3

Remaining Numbers new example sheet

Book1
	BK	BL	BM	BN	BO	BP	BQ	BR	BS	BT	BU	BV	BW	BX	BY	BZ	CA	CB	CC	CD	CE	CF	CG	CH	CI	CJ	CK	CL	CM	CN	CO	CP	CQ	CR	CS	CT	CU	CV	CW	CX	CY	CZ	DA	DB	DC	DD	DE	DF	DG	DH
1	1	2	3	4	5	6	7	8	9	10	11	12	13	14	15	16	17	18	19	20	21	22	23	24	25	26	27	28	29	30	31	32	33	34	35	36	37	38	39	40	41	42	43	44	45	46	47	48	49	50
2	n1	n2	n3	n4	n5	n6	n7	n8	n9	n10	n11	n12	n13	n14	n15	n16	n17	n18	n19	n20	n21	n22	n23	n24	n25	n26	n27	n28	n29	n30	n31	n32	n33	n34	n35	n36	n37	n38	n39	n40	n41	n42	n43	n44	n45	n46	n47	n48	n49	n50
3	1	2	3	4	5	6	7	8	9	10	11	12	13	14	15		17	18	19	20	21	22	23	24	25	26	27	28		30	31		33	34	35		37	38	39	40		42	43	44	45	46	47	48	49	50
4	1	2	3	4	5	6		8	9	10	11	12		14	15		17	18	19	20	21	22	23	24	25	26	27	28		30	31		33	34	35	36	37	38		40	41	42	43	44	45	46		48	49
5	1	2	3	4	5	6		8	9	10	11	12	13		15		17			20	21	22	23	24	25	26	27	28		30			33	34	35			38		40		42	43	44	45	46		48	49
6	1	2	3		5	6		8	9	10	11	12			15		17			20	21	22	23	24	25	26	27	28		30				34	35			38		40		42	43	44	45	46		48	49
7
8
9
10
11
12
13
14
15
16
17
Sheet1-3

Thank you very much

Regards,
Moti

 

[kalak]

Sub moti3()

Const q As Long = 50
Dim a, b() As Boolean, u(), v()
Dim i As Long, j As Long, n As Long, x As Long, y As Long
n = Cells(Rows.Count, "d").End(xlUp).Row
a = Range("D:H").Resize(n)
ReDim b(1 To q), u(1 To n, 1 To q), v(1 To n, 1 To q)

For i = 3 To n
    For j = 1 To 5
        If Not b(a(i, j)) Then b(a(i, j)) = True: c = c + 1
    Next j
    For j = 1 To q
        If b(j) Then u(i, j) = j Else v(i, j) = j
    Next j
     If c = q Then ReDim b(1 To q): c = 0
Next i

Range("L1").Resize(n, q) = u
Range("L1").Resize(n, q).Columns.AutoFit
Range("BK1").Resize(n, q) = v
Range("BK1").Resize(n, q).Columns.AutoFit

End Sub