Count history by colours or by the group

[Kishan]

Hi,</SPAN></SPAN>

I got patterns divide by 3 groups as shown in the cells C1:F3, and the conditional formula in the Column D6 to down is applied by formula is find under this link</SPAN></SPAN>
https://www.mrexcel.com/forum/excel...er-group-pattern-post5138986.html#post5138986</SPAN></SPAN>

What I need to count D6 below pattern by their colour or by the group as appeared in the column D</SPAN></SPAN>

And the historical count I need that the counts be shown in the column F6 to down as per their colours or by group and cell should be coloured as per coloured count to know which count corresponds to which colour or groups </SPAN></SPAN>

Result data example</SPAN></SPAN>

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

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

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

 

[MickG]

Try this:-

[COLOR="Navy"]Sub[/COLOR] MG14Sep04
[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] c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] col [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Temp [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Num [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Set[/COLOR] Rng = Range("C1,C2:F2,C3:F3")
c = 5
[COLOR="Navy"]With[/COLOR] CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
    [COLOR="Navy"]Select[/COLOR] [COLOR="Navy"]Case[/COLOR] Dn.Row
        [COLOR="Navy"]Case[/COLOR] 1: col = 255
        [COLOR="Navy"]Case[/COLOR] 2: col = 32768
        [COLOR="Navy"]Case[/COLOR] 3: col = 16711680
    [COLOR="Navy"]End[/COLOR] Select
        .Item(Dn.Value) = col
[COLOR="Navy"]Next[/COLOR]
[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("D6"), Range("D" & Rows.Count).End(xlUp))
    Temp = .Item(Rng(1).Value)
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
    [COLOR="Navy"]If[/COLOR] .Item(Dn.Value) = Temp [COLOR="Navy"]Then[/COLOR] Num = Num + 1
    [COLOR="Navy"]If[/COLOR] Not .Item(Dn.Value) = Temp [COLOR="Navy"]Then[/COLOR]
        c = c + 1
        Cells(c, "F") = Num: Num = 1
        Cells(c, "F").Interior.Color = Temp
        Cells(c, "F").Font.Color = vbWhite
        Temp = .Item(Dn.Value)
    [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR] Dn
        c = c + 1
        Cells(c, "F") = Num: Num = 1
        Cells(c, "F").Interior.Color = Temp
        Cells(c, "F").Font.Color = vbWhite
[COLOR="Navy"]End[/COLOR] With


[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[Kishan]

Try this:-

[COLOR=navy]Sub[/COLOR] MG14Sep04
[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] c [COLOR=navy]As[/COLOR] [COLOR=navy]Long[/COLOR]
[COLOR=navy]Dim[/COLOR] col [COLOR=navy]As[/COLOR] [COLOR=navy]Long,[/COLOR] Temp [COLOR=navy]As[/COLOR] [COLOR=navy]Long,[/COLOR] Num [COLOR=navy]As[/COLOR] [COLOR=navy]Long[/COLOR]
[COLOR=navy]Set[/COLOR] Rng = Range("C1,C2:F2,C3:F3")
c = 5
[COLOR=navy]With[/COLOR] CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
[COLOR=navy]For[/COLOR] [COLOR=navy]Each[/COLOR] Dn [COLOR=navy]In[/COLOR] Rng
    [COLOR=navy]Select[/COLOR] [COLOR=navy]Case[/COLOR] Dn.Row
        [COLOR=navy]Case[/COLOR] 1: col = 255
        [COLOR=navy]Case[/COLOR] 2: col = 32768
        [COLOR=navy]Case[/COLOR] 3: col = 16711680
    [COLOR=navy]End[/COLOR] Select
        .Item(Dn.Value) = col
[COLOR=navy]Next[/COLOR]
[COLOR=navy]Set[/COLOR] Rng = Range(Range("D6"), Range("D" & Rows.Count).End(xlUp))
    Temp = .Item(Rng(1).Value)
[COLOR=navy]For[/COLOR] [COLOR=navy]Each[/COLOR] Dn [COLOR=navy]In[/COLOR] Rng
    [COLOR=navy]If[/COLOR] .Item(Dn.Value) = Temp [COLOR=navy]Then[/COLOR] Num = Num + 1
    [COLOR=navy]If[/COLOR] Not .Item(Dn.Value) = Temp [COLOR=navy]Then[/COLOR]
        c = c + 1
        Cells(c, "F") = Num: Num = 1
        Cells(c, "F").Interior.Color = Temp
        Cells(c, "F").Font.Color = vbWhite
        Temp = .Item(Dn.Value)
    [COLOR=navy]End[/COLOR] If
[COLOR=navy]Next[/COLOR] Dn
        c = c + 1
        Cells(c, "F") = Num: Num = 1
        Cells(c, "F").Interior.Color = Temp
        Cells(c, "F").Font.Color = vbWhite
[COLOR=navy]End[/COLOR] With


[COLOR=navy]End[/COLOR] [COLOR=navy]Sub[/COLOR]

Regards Mick

Mick, it worked like magic as request.</SPAN></SPAN>

Thank you so much</SPAN></SPAN>

Have a good weekend</SPAN></SPAN>

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

 

[MickG]

You're welcome
Regrds Mick