Count maximum to minimum consecutives

[Kishan]

Using Excel 2000

Hi,

I have got data in column C:P, and need results in columns T:Z

1-In the column T, I need first max consecutive count of "X's"
2-In the column U, I need second max consecutive count of "X's"
3- and continue third, fourth max consecutive in to columns V through Z

Example data.

Book1
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T	U	V	W	X	Y	Z	AA
1
2
3
4
5			P1	P2	P3	P4	P5	P6	P7	P8	P9	P10	P11	P12	P13	P14			Total X	X	X	X	X	X	X	X
6			X	1	2	1	2	X	X	1	1	2	X	1	1	2			4	2	1	1
7			1	X	2	2	2	1	X	X	2	2	X	X	1	1			5	2	2	1
8			1	X	1	1	X	X	2	2	X	X	1	1	X	X			7	2	2	2	1
9			1	X	1	2	2	1	X	1	1	X	1	2	2	1			3	1	1	1
10			X	1	X	1	X	1	1	X	1	1	1	X	X	1			6	2	1	1	1
11			X	X	X	1	1	1	1	X	1	X	2	1	2	X			6	3	1	1	1
12			2	X	1	1	1	2	X	X	X	1	1	1	2	1			4	3	1
13			X	1	X	X	1	1	1	1	1	1	1	X	1	1			4	2	1	1
14			1	X	X	1	2	1	2	1	1	1	2	X	2	X			4	2	1	1
15			X	2	X	1	1	X	1	1	1	1	X	1	1	X			5	1	1	1	1	1
16			1	1	1	1	1	1	X	X	X	1	1	1	2	X			4	3	1
17			1	2	1	2	X	1	1	2	X	2	1	1	1	X			3	1	1	1
18			1	X	X	1	1	2	X	X	1	X	1	1	X	1			6	2	2	1	1
19			1	X	X	1	1	2	1	1	2	2	1	X	1	1			3	2	1
20			1	1	1	X	1	1	1	1	X	1	1	1	1	1			2	1	1
21			X	1	2	X	1	1	1	2	X	1	1	2	X	X			5	2	1	1	1
22			1	1	1	X	1	X	X	1	X	1	1	1	1	1			4	2	1	1
23			1	1	1	1	1	X	X	2	1	1	1	1	1	2			2	2
24			1	1	1	1	1	1	1	1	1	1	2	X	X	1			2	2
25			1	2	2	1	1	1	1	1	1	1	1	X	1	1			1	1
26			1	1	X	1	1	1	1	1	1	1	1	1	2	1			1	1
27			X	X	X	1	1	1	X	1	1	2	X	1	1	1			5	3	1	1
28			X	2	1	1	2	1	1	1	1	1	X	X	1	X			4	2	1	1
29			1	X	2	2	1	1	1	2	X	X	1	1	1	X			4	2	1	1
30			2	1	X	X	1	1	X	X	1	X	1	1	1	1			5	2	2	1
31			1	X	1	2	2	1	1	1	1	2	1	1	1	X			2	1	1
32			X	1	1	1	1	1	2	1	2	X	X	1	X	X			5	2	2	1
33			2	X	X	1	1	X	1	1	X	X	X	X	1	X			8	4	2	1	1
34			1	1	1	1	1	X	X	1	X	2	X	X	X	X			7	4	2	1
35			1	1	1	1	X	1	X	X	X	2	2	1	2	1			4	3	1
36			1	X	X	1	1	1	X	1	1	X	1	X	2	X			6	2	1	1	1	1
37			1	X	X	1	X	X	1	2	1	X	X	1	1	X			7	2	2	2	1
38			X	1	X	X	X	1	1	1	X	X	X	X	X	X			10	6	3	1
39			1	X	X	X	X	X	1	1	X	1	2	1	1	1			6	5	1
40			X	X	X	1	X	X	1	1	1	X	X	1	2	1			7	3	2	2
41			2	X	X	1	1	1	X	X	X	1	X	X	X	X			9	4	3	2
42			X	2	1	X	1	X	1	1	X	1	X	2	X	1			6	1	1	1	1	1	1
43			X	1	1	1	1	2	2	X	X	2	1	X	X	1			5	2	2	1
44			1	X	X	X	X	X	X	X	X	1	1	X	2	1			9	8	1
45			1	1	X	X	1	2	1	X	X	X	X	X	X	1			8	6	2
46			X	1	X	1	X	1	X	2	X	X	X	X	1	X			9	4	1	1	1	1	1
47			2	X	X	1	X	1	X	1	X	X	X	X	1	2			8	4	2	1	1
48			X	1	X	2	X	1	X	1	X	X	1	2	X	X			8	2	2	1	1	1	1
49			X	X	1	X	X	2	X	X	X	X	1	X	X	1			10	4	2	2	2
50			1	1	1	X	X	1	X	X	1	X	2	X	X	X			8	3	2	2	1
51			X	X	1	2	1	1	2	X	X	X	X	X	X	X			9	7	2
52			2	1	1	X	X	X	X	X	1	X	X	X	X	X			10	5	5
53			2	1	1	1	1	X	1	X	X	1	X	X	X	2			6	3	2	1
54			1	X	X	2	1	X	2	1	X	X	X	X	2	X			8	4	2	1	1
55			1	2	X	X	1	2	X	1	1	X	X	X	X	X			8	5	2	1
56			1	2	X	1	X	1	X	X	1	X	1	1	X	X			7	2	2	1	1	1
57			2	X	2	1	2	X	X	1	2	2	X	X	X	X			7	4	2	1
58
59
60
Sheet1

Thank you in advance

Regards,
Kishan

 

[MickG]

Try this:-

[COLOR="Navy"]Sub[/COLOR] MG26May42
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, Dc [COLOR="Navy"]As[/COLOR] Range, nRng [COLOR="Navy"]As[/COLOR] Range, Txt [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String[/COLOR]
[COLOR="Navy"]Dim[/COLOR] Ac [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Num [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] R [COLOR="Navy"]As[/COLOR] Range, c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Sp [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Set[/COLOR] Rng = Range("C6:P57")
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng.Rows
 Ac = 19: c = 0
    [COLOR="Navy"]Set[/COLOR] nRng = Nothing
    [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dc [COLOR="Navy"]In[/COLOR] Dn.Cells
        [COLOR="Navy"]If[/COLOR] Dc.Value = "X" [COLOR="Navy"]Then[/COLOR]
            [COLOR="Navy"]If[/COLOR] nRng [COLOR="Navy"]Is[/COLOR] Nothing [COLOR="Navy"]Then[/COLOR] [COLOR="Navy"]Set[/COLOR] nRng = Dc Else [COLOR="Navy"]Set[/COLOR] nRng = Union(nRng, Dc)
        [COLOR="Navy"]End[/COLOR] If
    [COLOR="Navy"]Next[/COLOR] Dc
ReDim ray(1 To nRng.Areas.Count)
    [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] R [COLOR="Navy"]In[/COLOR] nRng.Areas
       c = c + 1
        ray(c) = R.Count
        Num = Num + R.Count
    [COLOR="Navy"]Next[/COLOR] R
    
    [COLOR="Navy"]For[/COLOR] c = 1 To UBound(ray)
         Ac = Ac + 1
         Cells(Dn.Row, Ac) = Application.Large(ray, c)
    [COLOR="Navy"]Next[/COLOR] c
    Cells(Dn.Row, 19) = Num: Num = 0
[COLOR="Navy"]Next[/COLOR] Dn
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[Kishan]

Try this:-

[COLOR=navy]Sub[/COLOR] MG26May42
[COLOR=navy]Dim[/COLOR] Rng [COLOR=navy]As[/COLOR] Range, Dn [COLOR=navy]As[/COLOR] Range, Dc [COLOR=navy]As[/COLOR] Range, nRng [COLOR=navy]As[/COLOR] Range, Txt [COLOR=navy]As[/COLOR] [COLOR=navy]String[/COLOR]
[COLOR=navy]Dim[/COLOR] Ac [COLOR=navy]As[/COLOR] [COLOR=navy]Long,[/COLOR] Num [COLOR=navy]As[/COLOR] [COLOR=navy]Long,[/COLOR] R [COLOR=navy]As[/COLOR] Range, c [COLOR=navy]As[/COLOR] [COLOR=navy]Long,[/COLOR] Sp [COLOR=navy]As[/COLOR] Variant
[COLOR=navy]Set[/COLOR] Rng = Range("C6:P57")
[COLOR=navy]For[/COLOR] [COLOR=navy]Each[/COLOR] Dn [COLOR=navy]In[/COLOR] Rng.Rows
 Ac = 19: c = 0
    [COLOR=navy]Set[/COLOR] nRng = Nothing
    [COLOR=navy]For[/COLOR] [COLOR=navy]Each[/COLOR] Dc [COLOR=navy]In[/COLOR] Dn.Cells
        [COLOR=navy]If[/COLOR] Dc.Value = "X" [COLOR=navy]Then[/COLOR]
            [COLOR=navy]If[/COLOR] nRng [COLOR=navy]Is[/COLOR] Nothing [COLOR=navy]Then[/COLOR] [COLOR=navy]Set[/COLOR] nRng = Dc Else [COLOR=navy]Set[/COLOR] nRng = Union(nRng, Dc)
        [COLOR=navy]End[/COLOR] If
    [COLOR=navy]Next[/COLOR] Dc
ReDim ray(1 To nRng.Areas.Count)
    [COLOR=navy]For[/COLOR] [COLOR=navy]Each[/COLOR] R [COLOR=navy]In[/COLOR] nRng.Areas
       c = c + 1
        ray(c) = R.Count
        Num = Num + R.Count
    [COLOR=navy]Next[/COLOR] R
    
    [COLOR=navy]For[/COLOR] c = 1 To UBound(ray)
         Ac = Ac + 1
         Cells(Dn.Row, Ac) = Application.Large(ray, c)
    [COLOR=navy]Next[/COLOR] c
    Cells(Dn.Row, 19) = Num: Num = 0
[COLOR=navy]Next[/COLOR] Dn
[COLOR=navy]End[/COLOR] [COLOR=navy]Sub[/COLOR]

Regards Mick

Mick ray:, code is absolutely prefect!!

Thank you for your kind help

Have a nice day

Good Luck

Kind Regards,
Kishan

 

[MickG]

You're welcome