Count each character after breakout

[Kishan]

Using Excel 2000</SPAN></SPAN>
Hi,</SPAN></SPAN>

Data are in columns C:D I want to count each character 1, X or 2 after each breakout when columns C=1 & D=1 in the same row</SPAN></SPAN>

For example when in the both columns in the same row find 1 & 1 do count of 1, X, 2 in the column "C" in the columns F:H and of the column "D" in the columns J:K as in the example below row 13 has 1 & 1 so C14:C28 counts are in F13:H28 And D13:D:28 counts are in J14:L28</SPAN></SPAN>

Example...

Book1
	A	B	C	D	E	F	G	H	I	J	K	L	M	N
1
2
3
4						P1	P1	P1		P2	P2	P2
5			P1	P2		1	X	2		1	X	2
6			X	X
7			2	X
8			X	1
9			X	1
10			1	2
11			X	1
12			X	1
13			1	1		0	0	0		0	0	0
14			X	1			1			1
15			X	X			2				1
16			2	X				1			2
17			2	2				2				1
18			2	1				3		2
19			2	1				4		3
20			2	X				5			3
21			1	X		1					4
22			2	X				6			5
23			2	1				7		4
24			X	2			3					2
25			2	1				8		5
26			X	1			4			6
27			1	2		2						3
28			2	X				9			6
29			1	1		0	0	0		0	0	0
30			1	X		1					1
31			1	1		0	0	0		0	0	0
32			1	1		0	0	0		0	0	0
33			1	2		1						1
34			2	1				1		1
35			1	2		2						2
36			1	1		0	0	0		0	0	0
37			2	2				1				1
38			X	2			1					2
39			2	1				2		1
40			1	X		1					1
41			1	1		0	0	0		0	0	0
42			1	1		0	0	0		0	0	0
43			2	1				1		1
44			2	2				2				1
45			X	1			1			2
46			X	X			2				1
47			X	X			3				2
48			1	1		0	0	0		0	0	0
49			1	2		1						1
50			X	1			1			1
51			1	2		2						2
52			X	2			2					3
53			X	2			3					4
54			1	1		0	0	0		0	0	0
55			1	2		1						1
56			2	X				1			1
57			1	2		2						2
58			2	X				2			2
59			1	X		3					3
60			2	2				3				3
61			2	1				4		1
62			2	2				5				4
63			1	1		0	0	0		0	0	0
64			2	2				1				1
65			X	X			1				1
66			2	X				2			2
67			1	X		1					3
68			2	2				3				2
69			X	2			2					3
70			1	2		2						4
71			X	2			3					5
72			1	2		3						6
73			1	X		4					4
74			2	1				4		1
75			1	2		5						7
76			1	1		0	0	0		0	0	0
77			1	X		1					1
78			2	2				1				1
79			1	2		2						2
80			X	1			1			1
81			2	X				2			2
82			1	1		0	0	0		0	0	0
83			2	1				1		1
84			1	X		1					1
85			1	2		2						1
86			1	X		3					2
87			X	1			1			2
88			1	2		4						2
89			2	1				2		3
90			2	2				3				3
91			X	X			2				3
92			1	2		5						4
93			1	2		6						5
94			2	2				4				6
95
96
97
98
Sheet1

</SPAN></SPAN>

Thank you in advance</SPAN></SPAN>


Regards,</SPAN></SPAN>
Kishan</SPAN></SPAN>

 

[MickG]

Try this:-

[COLOR="Navy"]Sub[/COLOR] MG10Mar02
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Ac [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] oSet [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Q [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Dim[/COLOR] Fd  [COLOR="Navy"]As[/COLOR] Boolean
[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("C6"), Range("C" & Rows.Count).End(xlUp))
[COLOR="Navy"]With[/COLOR] CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
[COLOR="Navy"]For[/COLOR] Ac = 0 To 1
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng.Offset(, Ac)
   [COLOR="Navy"]If[/COLOR] Cells(Dn.Row, "C") = 1 And Cells(Dn.Row, "D") = 1 [COLOR="Navy"]Then[/COLOR]
       [COLOR="Navy"]If[/COLOR] Ac = 0 And Cells(Dn.Row, "C") = 1 [COLOR="Navy"]Then[/COLOR] Dn.Offset(, 3).Resize(, 3) = 0
       [COLOR="Navy"]If[/COLOR] Ac = 1 And Cells(Dn.Row, "D") = 1 [COLOR="Navy"]Then[/COLOR] Dn.Offset(, 6).Resize(, 3) = 0
       .RemoveAll
     Fd = True
    [COLOR="Navy"]ElseIf[/COLOR] Fd [COLOR="Navy"]Then[/COLOR]
        [COLOR="Navy"]Select[/COLOR] [COLOR="Navy"]Case[/COLOR] Dn.Value
            [COLOR="Navy"]Case[/COLOR] 1: oSet = 3
            [COLOR="Navy"]Case[/COLOR] "X": oSet = 4
            [COLOR="Navy"]Case[/COLOR] 2: oSet = 5
        [COLOR="Navy"]End[/COLOR] Select
        oSet = IIf(Ac = 0, oSet, oSet + 3)
        
        [COLOR="Navy"]If[/COLOR] Not .Exists(Dn.Value) [COLOR="Navy"]Then[/COLOR]
           .Add Dn.Value, 1
            Dn.Offset(, oSet).Value = 1
        [COLOR="Navy"]Else[/COLOR]
           Q = .Item(Dn.Value)
           Q = Q + 1
           Dn.Offset(, oSet).Value = Q
        .Item(Dn.Value) = Q
    [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR]
Fd = False
[COLOR="Navy"]Next[/COLOR] Ac
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[Kishan]

Try this:-

[COLOR=navy]Sub[/COLOR] MG10Mar02
[COLOR=navy]Dim[/COLOR] Rng [COLOR=navy]As[/COLOR] Range, Dn [COLOR=navy]As[/COLOR] Range, n [COLOR=navy]As[/COLOR] [COLOR=navy]Long,[/COLOR] Ac [COLOR=navy]As[/COLOR] [COLOR=navy]Long,[/COLOR] oSet [COLOR=navy]As[/COLOR] [COLOR=navy]Long,[/COLOR] Q [COLOR=navy]As[/COLOR] Variant
[COLOR=navy]Dim[/COLOR] Fd  [COLOR=navy]As[/COLOR] Boolean
[COLOR=navy]Set[/COLOR] Rng = Range(Range("C6"), Range("C" & Rows.Count).End(xlUp))
[COLOR=navy]With[/COLOR] CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
[COLOR=navy]For[/COLOR] Ac = 0 To 1
[COLOR=navy]For[/COLOR] [COLOR=navy]Each[/COLOR] Dn [COLOR=navy]In[/COLOR] Rng.Offset(, Ac)
   [COLOR=navy]If[/COLOR] Cells(Dn.Row, "C") = 1 And Cells(Dn.Row, "D") = 1 [COLOR=navy]Then[/COLOR]
       [COLOR=navy]If[/COLOR] Ac = 0 And Cells(Dn.Row, "C") = 1 [COLOR=navy]Then[/COLOR] Dn.Offset(, 3).Resize(, 3) = 0
       [COLOR=navy]If[/COLOR] Ac = 1 And Cells(Dn.Row, "D") = 1 [COLOR=navy]Then[/COLOR] Dn.Offset(, 6).Resize(, 3) = 0
       .RemoveAll
     Fd = True
    [COLOR=navy]ElseIf[/COLOR] Fd [COLOR=navy]Then[/COLOR]
        [COLOR=navy]Select[/COLOR] [COLOR=navy]Case[/COLOR] Dn.Value
            [COLOR=navy]Case[/COLOR] 1: oSet = 3
            [COLOR=navy]Case[/COLOR] "X": oSet = 4
            [COLOR=navy]Case[/COLOR] 2: oSet = 5
        [COLOR=navy]End[/COLOR] Select
        oSet = IIf(Ac = 0, oSet, oSet + 3)
        
        [COLOR=navy]If[/COLOR] Not .Exists(Dn.Value) [COLOR=navy]Then[/COLOR]
           .Add Dn.Value, 1
            Dn.Offset(, oSet).Value = 1
        [COLOR=navy]Else[/COLOR]
           Q = .Item(Dn.Value)
           Q = Q + 1
           Dn.Offset(, oSet).Value = Q
        .Item(Dn.Value) = Q
    [COLOR=navy]End[/COLOR] If
[COLOR=navy]End[/COLOR] If
[COLOR=navy]Next[/COLOR]
Fd = False
[COLOR=navy]Next[/COLOR] Ac
[COLOR=navy]End[/COLOR] [COLOR=navy]With[/COLOR]
[COLOR=navy]End[/COLOR] [COLOR=navy]Sub[/COLOR]

Regards Mick

Wow! Mick, I liked the VBA solution it is superb working as required </SPAN></SPAN>

Thank you so much for your kind help</SPAN></SPAN>

Kind Regards,</SPAN></SPAN>
Kishan </SPAN></SPAN>

 

[MickG]

You're very welcome