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

 

[Tetra201]

See if this works for you:

Sub Test()
    Dim tmparr, i As Long, j As Long
    For i = 6 To 22
        tmparr = Split(WorksheetFunction.Trim(Replace(Join( _
            WorksheetFunction.Transpose(WorksheetFunction.Transpose( _
            Range("C" & i & ":P" & i))), ""), "o", " ")), " ")
        For j = 0 To UBound(tmparr)
            Cells(i, "R").Offset(0, j) = Len(tmparr(j))
        Next j
    Next i
End Sub

 

[motilulla]

See if this works for you:

Sub Test()
    Dim tmparr, i As Long, j As Long
    For i = 6 To 22
        tmparr = Split(WorksheetFunction.Trim(Replace(Join( _
            WorksheetFunction.Transpose(WorksheetFunction.Transpose( _
            Range("C" & i & ":P" & i))), ""), "o", " ")), " ")
        For j = 0 To UBound(tmparr)
            Cells(i, "R").Offset(0, j) = Len(tmparr(j))
        Next j
    Next i
End Sub

Tetra201, absolutely perfect!

Thank you so much for your kind help

Regards,
Moti

 

[Tetra201]

You are most welcome.

 

[Rick Rothstein]

See if this works for you:

Sub Test()
    Dim tmparr, i As Long, j As Long
    For i = 6 To 22
        [B][COLOR="#FF0000"]tmparr = Split(WorksheetFunction.Trim(Replace(Join( _
            WorksheetFunction.Transpose(WorksheetFunction.Transpose( _
            Range("C" & i & ":P" & i))), ""), "o", " ")), " ")[/COLOR][/B]
        For j = 0 To UBound(tmparr)
            Cells(i, "R").Offset(0, j) = Len(tmparr(j))
        Next j
    Next i
End Sub

Instead of using two WorksheetFunction.Transpose function calls, you can use a single WorksheetFunction.Index call instead...

tmparr = Split(WorksheetFunction.Trim(Replace(Join(WorksheetFunction.Index( _
         Range("C" & i & ":P" & i).Value, 1, 0), ""), "o", " ")), " ")

 

[motilulla]

Instead of using two WorksheetFunction.Transpose function calls, you can use a single WorksheetFunction.Index call instead...

tmparr = Split(WorksheetFunction.Trim(Replace(Join(WorksheetFunction.Index( _
         Range("C" & i & ":P" & i).Value, 1, 0), ""), "o", " ")), " ")

Hello Rick, I don't know what is the difference but anyhow I have replaced it as you suggested

Thank you for the help and suggestion.

Regards,
Moti

 

[Rick Rothstein]

Hello Rick, I don't know what is the difference but anyhow I have replaced it as you suggested

Probably not noticeable unless you have a humongous amount of data to process, but one Index function call is more efficient than two Transpose function calls.

 

[Tetra201]

Rick,
Thank you for the clever tip

 

[motilulla]

Probably not noticeable unless you have a humongous amount of data to process, but one Index function call is more efficient than two Transpose function calls.

Hello Rick, thank you very much for the explanation. Now I understand it can cause error with large amount of data. Really I am using large numbers so I already changed it for safety.

Regards,
Moti

 

[Rick Rothstein]

Rick,
Thank you for the clever tip

You are quite welcome. One thing I probably should mention... explicitly specifying the Value property on the Range reference is required to make the function call work.