Find cycle with in 4 rounds

[Kishan]

Using Excel 2000

Hi,

I need a macro, which look cycle for "1X2" within 4 rounds if not found go to next row and search within 4 next rounds

Data are in cells C6:C82
Step1-code start searching cycle for "1X2" in cells C6:C9 if cycle for "1X2" does not find continue to step-2

Setp-2 go to next 4 cycles in cells C7:C10 if cycle for "1X2" find insert 4 in to cell E7 and colour cells C7:C10 in green

Setp-3 go to next 4 cycles in cells C8:C11 if cycle for "1X2" does not find continue to step-4

Setp-4 go to next 4 cycles in cells C9:C12 if cycle for "1X2" find insert 4 in to cell E9 and colour cells C9:C12 in yellow (overleaping the colour C9:C10 cell will be change in yellow too)

And continue so on till end of the column c

Data example...

Book1
	A	B	C	D	E	F
1
2					Find Cycle
3					Within
4					4 Rounds
5			C1		4
6			X
7			X		4
8			X
9			2		4
10			1
11			1
12			X
13			1
14			1
15			1
16			X
17			1
18			1
19			X		4
20			1
21			1		4
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		4
35			2
36			1
37			X
38			X
39			X		4
40			1
41			X
42			2		4
43			X
44			X		4
45			1
46			1		4
47			2
48			1
49			X
50			X
51			X
52			X
53			X		4
54			2
55			X
56			1
57			X		4
58			1
59			1
60			2
61			X
62			2
63			1
64			1
65			1
66			X
67			X
68			1
69			X
70			1
71			1
72			1
73			1
74			1
75			1		4
76			1
77			2
78			X		4
79			1
80			1
81			2
82			2
83
84
85
86
Sheet2

Thank you in advance

Regards,
Kishan

 

[Drrellik]

Ok, so if I understand you. you need to evaluate the column C and find "x" and then evaluate the cell above it and the cell below it for a "1" and a "2" and if both are true meaning the cells are C6, C7, C8 = 1, x, 2 then you need to change the color and continue to search the column for the next set of "1,x,2" and do the same thing.

is that about right

 

[Kishan]

Ok, so if I understand you. you need to evaluate the column C and find "x" and then evaluate the cell above it and the cell below it for a "1" and a "2" and if both are true meaning the cells are C6, C7, C8 = 1, x, 2 then you need to change the color and continue to search the column for the next set of "1,x,2" and do the same thing.

is that about right

Hi Drrellik,

I want set of "1,x,2" to be find with in 4 rows starting in C6, C7, C8, C9 set can be (1, 1, x, 2), (x, 1, x, 2), (1, 1, 2, x), (2, x, x, 1) cycle must be completed in 4 rounds or in other words within 4 rows there is no cycle in first 4 rows, so look in to next 4 cells C7, C8, C9, C10 yes it is there (x, x, 2, 1) set of "1,x,2" so colour these cells in green and place 4 in the cell E7, --->continue to cells C8, C9, C10, C11 set of "1,x,2" not found, --->continue to cells C9, C10, C11, C12 yes it is there (2, 1, 1, x) set of "1,x,2" so colour these cells in yellow and place 4 in the cell E9 (of course colouring cells C9, C10, C11, C12 in yellow C9 & C10 will be changed green to yellow due to overlapping yellow colour)

And will continue finding set of "1,x,2" next 4 rows C10, C11, C12, C13 and so on....

Thank you

Regards,
Kishan

 

[MickG]

Why do rows 8,9,10 & 11 not qualify. ???

8			X
9			2		4
10			1
11			1

<tbody>
</tbody>

hh

 

[Kishan]

Why do rows 8,9,10 & 11 not qualify. ???

8			X
9			2		4
10			1
11			1

<tbody>
</tbody>

Hi MickG, I missed the true part explanation; you caught the point. Important is the cycle, not the 4 signs in the 4 rows. But always within 4 rounds

For example: there are 3 characters 1, X & 2

If cycle start with "1" it has to closed by "X or 2" like (1, X, X, 2) (1, 2, 1, X) (1, X, X, 2) or (1, 2, 2, X)
If cycle start with "X" it has to closed by "1 or 2" like (X, X, 1, 2) (X, X, 1, 2) (X, 1, X, 2) or (X, 2, 2, 1)
If cycle start with "2" it has to closed by "1 or X" like (2, 1, 1, X) (2, X, X, 1) (2, 1, 2, X) or (2, X, X, 1)

Hope this help

Thank you

Regards,
Kishan

 

[MickG]

Try this:-

[COLOR="Navy"]Sub[/COLOR] MG24Sep18
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, n1 [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Integer,[/COLOR] n2 [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Integer,[/COLOR] n3 [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Integer,[/COLOR] n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Integer,[/COLOR] Col [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Set[/COLOR] Rng = Range("C6", Range("C" & Rows.Count).End(xlUp))
Col = vbGreen
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
    n1 = 0: n2 = 0: n3 = 0
    [COLOR="Navy"]For[/COLOR] n = 0 To 3
        [COLOR="Navy"]Select[/COLOR] [COLOR="Navy"]Case[/COLOR] Dn.Offset(n).value
            [COLOR="Navy"]Case[/COLOR] 1: n1 = 1
            [COLOR="Navy"]Case[/COLOR] 2: n2 = 2
            [COLOR="Navy"]Case[/COLOR] "X": n3 = 3
        [COLOR="Navy"]End[/COLOR] Select
        [COLOR="Navy"]If[/COLOR] Application.Product(n1, n2, n3) > 0 [COLOR="Navy"]Then[/COLOR] [COLOR="Navy"]Exit[/COLOR] For
    [COLOR="Navy"]Next[/COLOR] n
[COLOR="Navy"]If[/COLOR] n = 3 And Application.Product(n1, n2, n3) > 0 [COLOR="Navy"]Then[/COLOR]
    Dn.Offset(, 2).value = 4
    Dn.Resize(4).Interior.Color = Col
    Col = IIf(Col = vbGreen, vbYellow, vbGreen)
[COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR] Dn
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[Kishan]

Try this:-

[COLOR=navy]Sub[/COLOR] MG24Sep18
[COLOR=navy]Dim[/COLOR] Rng [COLOR=navy]As[/COLOR] Range, Dn [COLOR=navy]As[/COLOR] Range, n1 [COLOR=navy]As[/COLOR] [COLOR=navy]Integer,[/COLOR] n2 [COLOR=navy]As[/COLOR] [COLOR=navy]Integer,[/COLOR] n3 [COLOR=navy]As[/COLOR] [COLOR=navy]Integer,[/COLOR] n [COLOR=navy]As[/COLOR] [COLOR=navy]Integer,[/COLOR] Col [COLOR=navy]As[/COLOR] [COLOR=navy]Long[/COLOR]
[COLOR=navy]Set[/COLOR] Rng = Range("C6", Range("C" & Rows.Count).End(xlUp))
Col = vbGreen
[COLOR=navy]For[/COLOR] [COLOR=navy]Each[/COLOR] Dn [COLOR=navy]In[/COLOR] Rng
    n1 = 0: n2 = 0: n3 = 0
    [COLOR=navy]For[/COLOR] n = 0 To 3
        [COLOR=navy]Select[/COLOR] [COLOR=navy]Case[/COLOR] Dn.Offset(n).value
            [COLOR=navy]Case[/COLOR] 1: n1 = 1
            [COLOR=navy]Case[/COLOR] 2: n2 = 2
            [COLOR=navy]Case[/COLOR] "X": n3 = 3
        [COLOR=navy]End[/COLOR] Select
        [COLOR=navy]If[/COLOR] Application.Product(n1, n2, n3) > 0 [COLOR=navy]Then[/COLOR] [COLOR=navy]Exit[/COLOR] For
    [COLOR=navy]Next[/COLOR] n
[COLOR=navy]If[/COLOR] n = 3 And Application.Product(n1, n2, n3) > 0 [COLOR=navy]Then[/COLOR]
    Dn.Offset(, 2).value = 4
    Dn.Resize(4).Interior.Color = Col
    Col = IIf(Col = vbGreen, vbYellow, vbGreen)
[COLOR=navy]End[/COLOR] If
[COLOR=navy]Next[/COLOR] Dn
[COLOR=navy]End[/COLOR] [COLOR=navy]Sub[/COLOR]

Regards Mick

You've been very helpful ray: MickG, code is running 100% OK!!

I thank you from the bottom of my heart.

Have a nice day

Kind Regards,

Kishan

 

[MickG]

You're welcome