Count the period once cycle is completed

[Kishan]

Hi,

This query is bit complicated I will try my best to explain it

Data are located in cells C6:I82 what I need to check cycle for 1, X & 2 among the 7 columns C through I one by one and count the max numbers where the cycle is completed within the 7 column and the count result show in column J

For example...

1st cycle of 1, X, 2 has been completed with in 27 periods in column I so far result in Cell I32 = 27

2nd cycle of 1, X, 2 has been completed with in 30 periods in column G so far result in Cell J62 = 30

And continue finding...

Column K shows only the summary of cycle counts.

Colours are filled just to shown to show example bit clearer.

Example data...

Book1
	A	B	C	D	E	F	G	H	I	J	K	L
1
2
3
4											Summary
5			C1	C2	C3	C4	C5	C6	C7		Count Cycle
6			X	1	1	1	2	X	X		27
7			X	2	X	1	2	1	1		30
8			X	1	1	1	2	X	X		15
9			2	1	1	1	1	2	1
10			1	1	1	1	1	X	1
11			X	X	X	1	2	1	1
12			X	1	1	2	1	1	X
13			1	X	X	1	1	2	X
14			1	1	X	1	X	X	X
15			1	X	1	1	X	1	X
16			X	X	2	X	X	1	X
17			1	X	1	1	1	1	X
18			1	1	X	1	1	2	1
19			X	1	1	1	1	2	X
20			1	1	1	X	1	2	X
21			1	1	1	X	1	2	X
22			2	X	X	1	1	2	1
23			1	1	2	1	2	1	X
24			X	1	1	1	1	X	1
25			1	1	1	1	1	1	1
26			X	1	2	1	X	X	X
27			1	X	X	2	1	1	1
28			1	1	2	X	X	X	1
29			1	1	1	1	X	1	X
30			1	1	1	X	1	1	1
31			1	1	1	1	1	1	1
32			1	1	1	X	X	X	2	27
33			2	1	1	2	1	2	X
34			1	1	1	1	1	1	X
35			2	1	X	X	X	1	X
36			1	X	1	X	1	1	2
37			X	1	1	1	1	2	X
38			X	1	X	1	1	2	1
39			X	2	1	X	X	X	1
40			1	1	1	X	1	2	X
41			X	X	X	1	1	1	1
42			2	2	1	1	1	X	2
43			X	1	1	1	1	1	2
44			X	1	1	1	X	1	1
45			1	X	2	1	1	1	1
46			1	1	2	1	1	1	X
47			2	1	1	X	1	1	X
48			1	1	1	1	1	1	1
49			X	X	1	1	X	2	2
50			X	1	X	1	1	1	1
51			X	X	X	X	1	X	1
52			X	1	X	1	1	1	2
53			X	1	X	1	1	1	X
54			2	X	X	X	1	X	2
55			X	2	1	2	1	1	2
56			1	2	2	2	X	X	2
57			X	X	1	1	1	2	X
58			1	X	X	1	X	X	1
59			1	X	1	1	1	1	1
60			2	X	1	1	1	X	1
61			X	2	1	X	1	1	1
62			2	1	2	1	2	2	1	30
63			1	1	1	1	1	X	1
64			1	2	1	2	1	X	1
65			1	1	1	X	1	1	1
66			X	X	1	1	1	1	1
67			X	2	2	X	1	1	2
68			1	2	1	1	X	1	1
69			X	1	1	2	1	1	X
70			1	1	1	1	1	X	X
71			1	1	2	1	X	X	1
72			1	X	X	1	1	1	2
73			1	1	X	2	X	1	1
74			1	X	1	1	X	1	1
75			1	X	1	1	2	1	1
76			1	X	1	1	1	1	2
77			2	1	1	1	1	2	2	15
78			1	X	2	1	1	X	X
79			1	1	1	1	1	1	X
80			1	1	1	1	1	X	1
81			2	2	2	X	1	X	X
82			2	X	1	1	2	X	1
83
84
85
86
Sheet1

Thank you in advance

Kishan

 

[Kishan]

Try adding the lines in red:

Sub GetCounts()
Dim counts(1 To 3, 1 To 7) As Long, r As Long, ctr As Long, r2 As Long, Cx(1 To 1, 1 To 7) As Long


    Application.ScreenUpdating = False
    
    Range("C:I").Interior.ColorIndex = xlNone
    Range("J:R").ClearContents
    Range("K5:R5") = Array("Count Cycle", "C1", "C2", "C3", "C4", "C5", "C6", "C7")
    r = 6
    ctr = 0
    r2 = 6
    Erase counts, Cx
    While Cells(r, "C") <> ""
        ctr = ctr + 1
        For i = 1 To 7
            If Cells(r, i + 2) = 1 Then counts(1, i) = 1
            If Cells(r, i + 2) = 2 Then counts(2, i) = 1
            If Cells(r, i + 2) = "X" Then counts(3, i) = 1
            If Cx(1, i) = 0 And counts(1, i) * counts(2, i) * counts(3, i) > 0 Then Cx(1, i) = ctr
        Next i
        If WorksheetFunction.Product(counts) > 0 Then
            Cells(r, "J") = ctr
            Cells(r2, "K") = ctr
            Range(Cells(r2, "L"), Cells(r2, "R")).Value = Cx
            r2 = r2 + 1
            ctr = 0
            Erase counts, Cx
        End If
        r = r + 1
    Wend
    
    r = 6
    r2 = 6
    While Cells(r, "K") <> ""
        For i = 1 To 7
            Cells(r2, i + 2).Resize(Cells(r, i + 11)).Interior.Color = vbYellow
        Next i
        r2 = r2 + Cells(r, "K").Value
        r = r + 1
    Wend

    Application.ScreenUpdating = True
    
End Sub

You've been very helpful Eric W, ray: thank you for adding a colour option, which help a lot distinguish the cycle zone very clearly

I thank you from the bottom of my heart.

Have a nice time good luck

Kind Regards,
Kishan