Count "0" and "1" in a single cell separated by vertical bar

[Kishan]

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

Data in columns C:P, need to count "0" and "1" in a single cell separated by vertical bar in the column R </SPAN></SPAN>

Example data</SPAN></SPAN>

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

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

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

 

[MickG]

Add to line, as shown in Red:-

        nStr = nStr & IIf(nStr = "", c, "|" & c)
        c = 0
    End If
End If

Dn.Offset(, 15).Value =[COLOR="#FF0000"][B] Dn.Value & " - " & [/B][/COLOR]nStr

nStr = "": c = 0
Next Dn
End Sub

 

[Kishan]

Add to line, as shown in Red:-

        nStr = nStr & IIf(nStr = "", c, "|" & c)
        c = 0
    End If
End If

Dn.Offset(, 15).Value =[COLOR=#ff0000][B] Dn.Value & " - " & [/B][/COLOR]nStr

nStr = "": c = 0
Next Dn
End Sub

MickG, thanks a lot for modifying code and adding the first number from column C, this change has made a unique sequence and avoided all duplicates</SPAN></SPAN>

I am grateful to you for your help. Have a nice day
</SPAN></SPAN>
Kind Regards,</SPAN></SPAN>
Kishan</SPAN></SPAN>

 

[Rick Rothstein]

Here is another (more compact) macro that should also work...

[table="width: 500"]
[tr]
	[td]Sub CountOnesAndZeros()
  Dim R As Long, X As Long, Data As Variant, Result As Variant, OnesAndZeroes() As String
  Data = Range("C5", Cells(Rows.Count, "P").End(xlUp))
  ReDim Result(1 To UBound(Data), 1 To 1)
  For R = 1 To UBound(Data)
    OnesAndZeroes = Split(Replace(Replace(Join(Application.Index(Data, R, 0), ""), "01", "0|1"), "10", "1|0"), "|")
    For X = 0 To UBound(OnesAndZeroes)
      OnesAndZeroes(X) = Len(OnesAndZeroes(X))
    Next
    Result(R, 1) = Data(R, 1) & " - " & Join(OnesAndZeroes, " | ")
  Next
  Range("R5").Resize(UBound(Result)) = Result
End Sub[/td]
[/tr]
[/table]

 

[Kishan]

Here is another (more compact) macro that should also work...

[TABLE="width: 500"]
<TBODY>[TR]
[TD]Sub CountOnesAndZeros()
  Dim R As Long, X As Long, Data As Variant, Result As Variant, OnesAndZeroes() As String
  Data = Range("C5", Cells(Rows.Count, "P").End(xlUp))
  ReDim Result(1 To UBound(Data), 1 To 1)
  For R = 1 To UBound(Data)
    OnesAndZeroes = Split(Replace(Replace(Join(Application.Index(Data, R, 0), ""), "01", "0|1"), "10", "1|0"), "|")
    For X = 0 To UBound(OnesAndZeroes)
      OnesAndZeroes(X) = Len(OnesAndZeroes(X))
    Next
    Result(R, 1) = Data(R, 1) & " - " & Join(OnesAndZeroes, " | ")
  Next
  Range("R5").Resize(UBound(Result)) = Result
End Sub
[/TD]
[/TR]
</TBODY>[/TABLE]

Thank you so much Rick, I do appreciate your help, compact code worked fine!! </SPAN></SPAN>

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

 

[MickG]

You're welcome