Count if 3 character "1 X 2" are find in the 3 rows.

[Kishan]

Using Excel 2000

Hi,


Count if 3 character "1 X 2" are find in the 3 rows no matter the if they are not in sequence (I mean can be "1X2", "X12", "2X1" or in any sequence no problem)

Data are in cells C6:I80 (count results in K6:K80

Look "1X2" into 3 rows STARTING FROM C6 for example....

Step1-Start looking in C6, C7, and C8 - D6, D7, and D8 - E6, E7, and E8 - F6, F7, and F8 - G6, G7, and G8 - H6, H7, and H8 - I6, I7, and I8 (DO NOT FOUND "1X2" RESULT = IN K8=0)

Step2-Start looking IN NEXT 3 ROWS C7, C8, and C9 - D7, D8, and D9 - E7, E8, and E9 - F7, F8, and F9 - G7, G8, and G9 - H7, H8, and H9 - I7, I8, and I8 (FOUND "1X2" in - I7, I8, and I8 RESULT = IN K9=1

Step3-Start looking IN NEXT 3 ROWS C8, C9, and C10 - D8, D9, and D10 - E8, E9, and E10 - F8, F9, and F10 - G8, G9, and G10 - H8, H9, and H10 - I8, I9, and I10 (FOUND "1X2" in - C8, C9, and C10 RESULT = IN K10=1

And continue finding into next 3 rows till end and result in column K

Example....

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

Thank you in advance

Regards,
Kishan

 

[Kenneth Hobson]

'=cCPGup(C9:I9,"1 x 2")
Function cCPGup(sRange As Range, G As String) As Integer
  Dim f As Range, r As Range, c As Range, i As Integer, j As Integer
  Dim a, e, n As Integer
  a = Split(G, " ")
  n = UBound(a)
  For Each c In sRange
    If c.Row - n < 1 Then GoTo NextC
    Set r = Range(c.Offset(-n), c)
    j = 0
    For Each e In a
      Set f = r.Find(e)
      If Not f Is Nothing Then j = j + 1
    Next e
    If j = 3 Then i = i + 1
NextC:
  Next c
  cCPGup = i
End Function

 

[Kishan]

'=cCPGup(C9:I9,"1 x 2")
Function cCPGup(sRange As Range, G As String) As Integer
  Dim f As Range, r As Range, c As Range, i As Integer, j As Integer
  Dim a, e, n As Integer
  a = Split(G, " ")
  n = UBound(a)
  For Each c In sRange
    If c.Row - n < 1 Then GoTo NextC
    Set r = Range(c.Offset(-n), c)
    j = 0
    For Each e In a
      Set f = r.Find(e)
      If Not f Is Nothing Then j = j + 1
    Next e
    If j = 3 Then i = i + 1
NextC:
  Next c
  cCPGup = i
End Function

Hi,

Kenneth Hobson, I just place the code in module and formula in K9 and copied down but I am getting results only 0's

I would like to have macro instead function is it possible?

Thank you

Regards,
Kishan

 

[Kenneth Hobson]

Works fine for me. Most don't know that I test 95% of what I post. Of course opinions vary for what "works".

Sure, any UDF can be ran as a Sub even more reliably. e.g.

Sub Test_cCPGup()
  MsgBox cCPGup(Range("C9:I9"), "1 X 2")
  MsgBox cCPGup(Range("C12:I12"), "1 X 2")
End Sub

If you want to test in my file, let me know.

 

[Kishan]

Works fine for me. Most don't know that I test 95% of what I post. Of course opinions vary for what "works".

Sure, any UDF can be ran as a Sub even more reliably. e.g.

Sub Test_cCPGup()
  MsgBox cCPGup(Range("C9:I9"), "1 X 2")
  MsgBox cCPGup(Range("C12:I12"), "1 X 2")
End Sub

If you want to test in my file, let me know.

Hi,

Kenneth Hobson, if I run this sub I am getting answer 1 & 1 which is correct I don't know what I am doing wrong with function here are the results

Book1
	A	B	C	D	E	F	G	H	I	J	K	L
1
2
3
4											Cycle
5			C1	C2	C3	C4	C5	C6	C7		Completad
6			X	1	1	1	2	1	2
7			X	X	2	1	X	X	1
8			X	1	1	1	2	1	2		0
9			2	1	1	X	2	1	X		0
10			1	X	1	X	1	1	2		0
11			X	2	X	X	2	X	1		0
12			X	1	1	2	1	1	1		0
13			1	X	X	2	1	X	1		0
14			1	1	1	2	X	X	X
15			1	X	X	1	1	1	1
16			X	1	X	2	1	2	X
17			1	1	X	1	2	1	X
18			1	1	1	1	1	X	1
Sheet2

Cell Formulas
Range	Formula
K9	=cCPGup(C9:I9,"1 x 2")
K10	=cCPGup(C10:I10,"1 x 2")
K11	=cCPGup(C11:I11,"1 x 2")
K12	=cCPGup(C12:I12,"1 x 2")
K13	=cCPGup(C13:I13,"1 x 2")

Thank you

Regards,
Kishan

 

[Kenneth Hobson]

The only way I can duplicate that is if Calculation is set to Manual.

 

[Kishan]

The only way I can duplicate that is if Calculation is set to Manual.

Hi,

Kenneth Hobson, I check in options the Calculation is set automatic, or is it because I am using version 2000? That I have mentioned in opening post

Thank you

Regards,
Kishan

 

[Kenneth Hobson]

That is so old, I don't know. You can test mine if you like.
https://www.dropbox.com/s/whnqcu62odqczit/Count Consecutive Permuation Groups UP.xlsm?dl=0

 

[Eric W]

I got Kenneth's UDF to work fine. But in case you still have issues getting it to work, here's a basic subroutine you can try:

Sub CheckCycle()
Dim r As Long, c As Long, ctr As Long, x As Boolean

    For r = 9 To Cells(Rows.Count, "C").End(xlUp).Row
        ctr = 0
        For c = 3 To 9
            x = (WorksheetFunction.CountIf(Cells(r - 2, c).Resize(3), 1) > 0) And _
                (WorksheetFunction.CountIf(Cells(r - 2, c).Resize(3), 2) > 0) And _
                (WorksheetFunction.CountIf(Cells(r - 2, c).Resize(3), "X") > 0)
            If x Then ctr = ctr + 1
        Next c
        Cells(r, "K") = ctr
    Next r
    
End Sub

 

[Kishan]

That is so old, I don't know. You can test mine if you like.
https://www.dropbox.com/s/whnqcu62odqczit/Count Consecutive Permuation Groups UP.xlsm?dl=0

Hi,

Kenneth Hobson, I have absolutely no doubt with your function code it is working fine with newer version. I am sure it is my version, which is not compatible.

I do appreciate your help and time.

Good Luck

Thank you

Regards,
Kishan