Count consecutive occurrences of only 1

[motilulla]

Happy New Year to everyone

Hello,

I am looking VBA solution, which count the constant occurrences of 1 only

Data got in cells C6:P22,

Results shown in R6 AF22

Sample 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	AB	AC	AD	AE	AF	AG	AH
1
2
3
4
5			P1	P2	P3	P4	P5	P6	P7	P8	P9	P10	P11	P12	P13	P14		P1	P2	P3	P4	P5	P6	P7	P8	P9	P10	P11	P12	P13	P14	P15
6			o	1	o	o	o	1	1	1	1	o	1	1	o	o		1	4	2
7			o	o	1	o	1	o	o	o	o	1	o	o	o	1		1	1	1	1
8			o	o	1	o	1	o	o	1	1	o	o	o	o	1		1	1	2	1
9			o	o	1	1	o	o	o	1	o	1	o	o	o	o		2	1	1
10			1	o	o	1	o	1	1	1	1	o	1	1	1	o		1	1	4	3
11			1	o	o	o	1	o	1	1	o	o	1	1	1	1		1	1	2	4
12			o	o	1	o	o	o	o	o	1	1	1	1	o	o		1	4
13			o	1	1	o	1	o	1	1	1	1	1	o	1	1		2	1	5	2
14			1	o	o	o	o	o	1	o	1	o	1	1	1	1		1	1	1	4
15			o	o	o	o	o	1	1	1	o	1	o	1	1	o		3	1	2
16			1	1	1	o	1	1	1	1	o	o	1	o	1	1		3	4	1	2
17			o	o	1	o	o	o	o	1	o	1	1	1	o	o		1	1	3
18			o	o	1	o	1	o	o	1	1	o	1	1	o	1		1	1	2	2	1
19			o	o	o	o	o	o	1	o	1	1	1	1	o	o		1	4
20			1	o	1	1	o	1	1	1	1	o	o	o	o	1		1	2	4	1
21			o	o	o	o	o	o	o	o	o	o	o	o	o	1		1
22			1	1	1	1	1	1	o	1	1	1	1	1	1	1		6	7
23
Sheet1

Thank you all
Excel 2000
Regards,
Moti

 

[motilulla]

Hello, again whether it is solved. Please I want results in single column could be changed as shown below

Book1
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S
1
2
3
4
5			P1	P2	P3	P4	P5	P6	P7	P8	P9	P10	P11	P12	P13	P14		Results
6			o	1	o	o	o	1	1	1	1	o	1	1	o	o		1 | 4 | 2
7			o	o	1	o	1	o	o	o	o	1	o	o	o	1		1 | 1 | 1 | 1
8			o	o	1	o	1	o	o	1	1	o	o	o	o	1		1 | 1 | 2 | 1
9			o	o	1	1	o	o	o	1	o	1	o	o	o	o		2 | 1 | 1
10			1	o	o	1	o	1	1	1	1	o	1	1	1	o		1 | 1 | 4 | 3
11			1	o	o	o	1	o	1	1	o	o	1	1	1	1		1 | 1 | 2 | 4
12			o	o	1	o	o	o	o	o	1	1	1	1	o	o		1 | 4
13			o	1	1	o	1	o	1	1	1	1	1	o	1	1		2 | 1 | 5 | 2
14			1	o	o	o	o	o	1	o	1	o	1	1	1	1		1 | 1 | 1 | 4
15			o	o	o	o	o	1	1	1	o	1	o	1	1	o		3 | 1 | 2
16			1	1	1	o	1	1	1	1	o	o	1	o	1	1		3 | 4 | 1 | 2
17			o	o	1	o	o	o	o	1	o	1	1	1	o	o		1 | 1 | 3
18			o	o	1	o	1	o	o	1	1	o	1	1	o	1		1 | 1 | 2 | 2 | 1
19			o	o	o	o	o	o	1	o	1	1	1	1	o	o		1 | 4
20			1	o	1	1	o	1	1	1	1	o	o	o	o	1		1 | 2 | 4 | 1
21			o	o	o	o	o	o	o	o	o	o	o	o	o	1		1
22			1	1	1	1	1	1	o	1	1	1	1	1	1	1		6 | 7
23
24
Sheet2

Thank you

Regards,
Moti

 

[Tetra201]

Here is a modified code for you to try:

Sub Test1()
    Dim tmparr, i As Long, j As Long
    For i = [COLOR=#ff0000]6[/COLOR] To [COLOR=#ff0000]22[/COLOR]
        tmparr = Split(WorksheetFunction.Trim(Replace(Join(WorksheetFunction.Index( _
            Range("C" & i & ":P" & i).Value, 1, 0), ""), "o", " ")), " ")
        For j = 0 To UBound(tmparr)
            tmparr(j) = Len(tmparr(j))
        Next j
        Cells(i, "R") = Join(tmparr, " | ")
    Next i
    Range("R[COLOR=#ff0000]6[/COLOR]:R[COLOR=#ff0000]22[/COLOR]").NumberFormat = "@"
End Sub

 

[motilulla]

Here is a modified code for you to try:

Sub Test1()
    Dim tmparr, i As Long, j As Long
    For i = [COLOR=#ff0000]6[/COLOR] To [COLOR=#ff0000]22[/COLOR]
        tmparr = Split(WorksheetFunction.Trim(Replace(Join(WorksheetFunction.Index( _
            Range("C" & i & ":P" & i).Value, 1, 0), ""), "o", " ")), " ")
        For j = 0 To UBound(tmparr)
            tmparr(j) = Len(tmparr(j))
        Next j
        Cells(i, "R") = Join(tmparr, " | ")
    Next i
    Range("R[COLOR=#ff0000]6[/COLOR]:R[COLOR=#ff0000]22[/COLOR]").NumberFormat = "@"
End Sub

Tetra201, very much appreciated! Code is working as treat

Thank you so much for your kind help and modifying it.

Regards,
Moti