Joint 2 macros

[motilulla]

Hello @Phuoc, you provide 2 VBA which are working spot-on. Please can you make 1 VBA out of 2 which get count and delay at once? Thank you.

Find Dealy MrExcel.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q
1
2
3															VBA	VBA
4		Draw S.N		Results											Count	Delay
5		Draw S.N		n1	n2	n3	n4	n5			Quads				Quads	Quads
6		1	13/02/2004	16	29	32	36	41			16	29	32	36	1	29
7		2	20/02/2004	7	13	39	47	50			15	24	28	44	2	14
8		3	27/02/2004	14	18	19	31	37			8	12	14	15	2	0
9		4	05/03/2004	4	7	33	37	39			3	21	30	34	1	10
10		5	12/03/2004	15	24	28	44	47			4	12	24	36	1	22
11		6	19/03/2004	33	36	37	42	45			14	15	28	35	1	20
12		7	26/03/2004	3	4	10	23	43			9	13	34	41	1	13
13		8	02/04/2004	4	12	24	27	36			5	15	24	35	1	4
14		9	09/04/2004	1	4	10	19	23			1	11	22	28	1	1
15		10	16/04/2004	14	15	28	35	40			16	29	32	41	1	29
16		11	23/04/2004	6	10	21	45	49			15	16	21	36	1	17
17		12	30/04/2004	5	6	16	23	27			20	27	41	43	1	3
18		13	07/05/2004	15	16	21	36	38			8	12	15	34	1	0
19		14	14/05/2004	1	3	21	32	39
20		15	21/05/2004	15	29	37	39	49
21		16	28/05/2004	15	24	28	32	44
22		17	04/06/2004	9	13	34	41	42
23		18	11/06/2004	2	7	8	10	47
24		19	18/06/2004	2	23	28	40	43
25		20	25/06/2004	3	21	30	34	35
26		21	02/07/2004	8	12	14	15	37
27		22	09/07/2004	2	5	12	19	44
28		23	16/07/2004	24	26	31	38	50
29		24	23/07/2004	7	10	27	31	34
30		25	30/07/2004	9	10	19	37	50
31		26	06/08/2004	5	15	24	35	44
32		27	13/08/2004	20	27	41	43	50
33		28	20/08/2004	6	9	10	27	35
34		29	27/08/2004	1	11	22	28	44
35		30	03/09/2004	8	12	14	15	34
36
37
38
Join VBA Count & Delay

Macro 1 Counts...

'https://www.mrexcel.com/board/threads/loop-set-of-3-within-5-results.1262915/#post-6207593
Sub Count_lottery() 'By Phuoc
Dim a As Variant, b As Variant, c As Variant
Dim i&, j&, ra&, rb&, temp$
Dim t As Double
t = Timer
a = Range("D6", Range("H" & Rows.Count).End(xlUp)).Value
b = Range("K6", Range("N" & Rows.Count).End(xlUp)).Value
ra = UBound(a, 1)
rb = UBound(b, 1)
ReDim c(1 To rb, 1 To 2)
For i = 1 To rb
    c(i, 2) = "*" & Format(b(i, 1), "00") & "|*" & Format(b(i, 2), "00") & "|*" & Format(b(i, 3), "00") & "|*" & Format(b(i, 4), "00") & "|*"
Next i
For j = 1 To ra
    temp = Format(a(j, 1), "00|") & Format(a(j, 2), "00|") & Format(a(j, 3), "00|") & Format(a(j, 4), "00|") & Format(a(j, 5), "00|")
    For i = 1 To rb
        If temp Like c(i, 2) Then c(i, 1) = c(i, 1) + 1
    Next i
Next j
Range("O6").Resize(rb, 1) = c
MsgBox Timer - t
End Sub

Macro 2 Delay...

'https://www.mrexcel.com/board/threads/find-quads-delay-loop-quads-within-5-n1-n5-results.1263090/#post-6208040
Sub Last_Delay_V2() 'By Phuoc
Dim a As Variant, b As Variant, c As Variant
Dim i&, j&, ra&, rb&, temp$
Dim t As Double
t = Timer
a = Range("D6", Range("H" & Rows.Count).End(xlUp)).Value
b = Range("K6", Range("N" & Rows.Count).End(xlUp)).Value
ra = UBound(a, 1)
rb = UBound(b, 1)
ReDim c(1 To rb, 1 To 1)

For j = 1 To ra
    a(j, 1) = Format(a(j, 1), "00|") & Format(a(j, 2), "00|") & Format(a(j, 3), "00|") & Format(a(j, 4), "00|") & Format(a(j, 5), "00|")
Next j

For i = 1 To rb
    temp = "*" & Format(b(i, 1), "00") & "|*" & Format(b(i, 2), "00") & "|*" & Format(b(i, 3), "00") & "|*" & Format(b(i, 4), "00") & "|*"
    For j = ra To 1 Step -1
        If a(j, 1) Like temp Then
           c(i, 1) = ra - j
           Exit For
        End If
    Next j
Next i
Range("P6").Resize(rb, 1) = c
MsgBox Timer - t
End Sub

Regards,
Moti

 

[Phuoc]

Try this:

Sub Count_And_Last_Delay() 'By Phuoc
Dim a As Variant, b As Variant, c As Variant
Dim i&, j&, ra&, rb&, temp$
Dim t As Double
t = Timer
a = Range("D6", Range("H" & Rows.Count).End(xlUp)).Value
b = Range("K6", Range("N" & Rows.Count).End(xlUp)).Value
ra = UBound(a, 1)
rb = UBound(b, 1)
ReDim c(1 To rb, 1 To 3)
For i = 1 To rb
    c(i, 3) = "*" & Format(b(i, 1), "00") & "|*" & Format(b(i, 2), "00") & "|*" & Format(b(i, 3), "00") & "|*" & Format(b(i, 4), "00") & "|*"
Next i
For j = 1 To ra
    temp = Format(a(j, 1), "00|") & Format(a(j, 2), "00|") & Format(a(j, 3), "00|") & Format(a(j, 4), "00|") & Format(a(j, 5), "00|")
    For i = 1 To rb
        If temp Like c(i, 3) Then
            c(i, 1) = c(i, 1) + 1
            c(i, 2) = ra - j
        End If
    Next i
Next j
Range("O6").Resize(rb, 2) = c
MsgBox Timer - t
End Sub

 

[motilulla]

Try this:

Sub Count_And_Last_Delay() 'By Phuoc
Dim a As Variant, b As Variant, c As Variant
Dim i&, j&, ra&, rb&, temp$
Dim t As Double
t = Timer
a = Range("D6", Range("H" & Rows.Count).End(xlUp)).Value
b = Range("K6", Range("N" & Rows.Count).End(xlUp)).Value
ra = UBound(a, 1)
rb = UBound(b, 1)
ReDim c(1 To rb, 1 To 3)
For i = 1 To rb
    c(i, 3) = "*" & Format(b(i, 1), "00") & "|*" & Format(b(i, 2), "00") & "|*" & Format(b(i, 3), "00") & "|*" & Format(b(i, 4), "00") & "|*"
Next i
For j = 1 To ra
    temp = Format(a(j, 1), "00|") & Format(a(j, 2), "00|") & Format(a(j, 3), "00|") & Format(a(j, 4), "00|") & Format(a(j, 5), "00|")
    For i = 1 To rb
        If temp Like c(i, 3) Then
            c(i, 1) = c(i, 1) + 1
            c(i, 2) = ra - j
        End If
    Next i
Next j
Range("O6").Resize(rb, 2) = c
MsgBox Timer - t
End Sub

Wow Phuoc, separate each macro was taking 20 seconds total 40 second both, joining them together counts and delays both just took 20 second half of the time than individuals.

I love your coding thank you for time you spent to solve my entire request.

I wish you Good Luck.

Best Regards,
Moti