Count "Start & End patterns" for each cycle done.

[Kishan]

Using Excel 2000

Hi,

Perhaps this query is not so easy as title looks in fact the question is 2 in 1, 1st find the cycle and then the count's

Data are in cells C6:C82 change colour shows the cycle for "1X2" - E6:F11 are the start & end cycle patterns - G6:G11 is the result counts of pattern cycle

For example...
In the each cycle there would be 6 patterns 1-X, 1-2, X-1, X-2, 2-1 & 2-X as specified in cells E6:F11

1st cycle of "1X2" start with "X" in C6 and end with "1" in cell C10 (so X-1 counts will go in cells G8)

2nd cycle of "1X2" start with "X" in C11 and end with "2" in cell C20 (so X-2 counts will go in cells G9)

And so on...

Example data...

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

Thank you in advance

Kishan

 

[Eric W]

Try:

Sub GetCounts()
Dim counts(1 To 3) As Long, r As Long, i As Long, StartVal As String, res(1 To 6, 1 To 1), se As Variant

    r = 6
    se = Array("1X", "12", "X1", "X2", "21", "2X")
    StartVal = Cells(r, "C").Value
    While Cells(r, "C") <> ""
        If Cells(r, "C") = 1 Then counts(1) = 1
        If Cells(r, "C") = 2 Then counts(2) = 1
        If Cells(r, "C") = "X" Then counts(3) = 1

        If WorksheetFunction.Product(counts) > 0 Then
            StartVal = StartVal & Cells(r, "C").Value
            i = WorksheetFunction.Match(StartVal, se, 0)
            res(i, 1) = res(i, 1) + 1
            Erase counts
            StartVal = Cells(r + 1, "C").Value
        End If
        r = r + 1
    Wend
    Range("G6:G11").Value = res
    
End Sub

 

[Kishan]

Try:

Sub GetCounts()
Dim counts(1 To 3) As Long, r As Long, i As Long, StartVal As String, res(1 To 6, 1 To 1), se As Variant

    r = 6
    se = Array("1X", "12", "X1", "X2", "21", "2X")
    StartVal = Cells(r, "C").Value
    While Cells(r, "C") <> ""
        If Cells(r, "C") = 1 Then counts(1) = 1
        If Cells(r, "C") = 2 Then counts(2) = 1
        If Cells(r, "C") = "X" Then counts(3) = 1

        If WorksheetFunction.Product(counts) > 0 Then
            StartVal = StartVal & Cells(r, "C").Value
            i = WorksheetFunction.Match(StartVal, se, 0)
            res(i, 1) = res(i, 1) + 1
            Erase counts
            StartVal = Cells(r + 1, "C").Value
        End If
        r = r + 1
    Wend
    Range("G6:G11").Value = res
    
End Sub

Awesome! Eric, Exactly what I was looking for

Thank you so much for your precious time and help.

Kind Regards,
Kishan