Count the distance Between 1 and 2

[Kishan]

Using Excel 2000</SPAN></SPAN>

Hi,</SPAN></SPAN>

I want to count the distance between the character "1" and "2", count start should be with "1" and to last "2" </SPAN></SPAN>

Data are in columns C:P, and the count results are shown in the columns S:AF</SPAN></SPAN>

Note optional request: if possible could be highlighted columns C:P as shown </SPAN></SPAN>

Result data example</SPAN></SPAN>

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			C1	C2	C3	C4	C5	C6	C7	C8	C9	C10	C11	C12	C13	C14			C1	C2	C3	C4	C5	C6	C7	C8	C9	C10	C11	C12	C13	C14
6			X	1	2	1	2	X	X	1	1	2	X	1	1	2			2	2	3	3
7			1	X	2	2	2	1	X	X	2	2	X	X	1	1			5	5
8			1	X	1	1	X	X	2	2	X	X	1	1	X	X			8
9			1	X	1	2	2	1	X	1	1	X	1	2	2	1			5	8
10			X	1	X	1	X	1	1	X	1	1	1	X	X	1
11			X	X	X	1	1	1	1	X	1	X	2	1	2	X			8	2
12			2	X	1	1	1	2	X	X	X	1	1	1	2	1			4	4
13			X	1	X	X	1	1	1	1	1	1	1	X	1	1
14			1	X	X	1	2	1	2	1	1	1	2	X	2	X			5	2	4
15			X	2	X	1	1	X	1	1	1	1	X	1	1	X
16			1	1	1	1	1	1	X	X	X	1	1	1	2	X			13
17			1	2	1	2	X	1	1	2	X	2	1	1	1	X			2	2	3
18			1	X	X	1	1	2	X	X	1	X	1	1	X	1			6
19			1	X	X	1	1	2	1	1	2	2	1	X	1	1			6	4
20			1	1	1	X	1	1	1	1	X	1	1	1	1	1
21			X	1	2	X	1	1	1	2	X	1	1	2	X	X			2	4	3
22			1	1	1	X	1	X	X	1	X	1	1	1	1	1
23			1	1	1	1	1	X	X	2	1	1	1	1	1	2			8	6
24			1	1	1	1	1	1	1	1	1	1	2	X	X	1			11
25			1	2	2	1	1	1	1	1	1	1	1	X	1	1			3
26			1	1	X	1	1	1	1	1	1	1	1	1	2	1			13
27			X	X	X	1	1	1	X	1	1	2	X	1	1	1			8
28			X	2	1	1	2	1	1	1	1	1	X	X	1	X			3
29			1	X	2	2	1	1	1	2	X	X	1	1	1	X			4	4
30			2	1	X	X	1	1	X	X	1	X	1	1	1	1
31			1	X	1	2	2	1	1	1	1	2	1	1	1	X			5	5
32			1	1	X	1	2	2	2	1	1	X	1	X	1	X			7
33			2	1	X	1	X	1	X	1	1	1	1	1	1	1
34			X	1	1	1	1	1	2	1	2	X	X	1	X	X			6	2
35			1	2	1	1	X	1	1	1	X	2	X	1	X	X			2	8
36			X	1	1	1	1	X	1	2	1	1	X	1	X	X			7
37			2	X	1	1	1	X	X	1	1	X	1	1	X	1
38			1	X	2	X	1	X	1	1	1	1	1	2	1	X			3	8
39			X	1	X	X	1	X	1	1	X	1	2	2	1	1			11
40			1	X	X	1	2	X	1	1	X	1	X	1	2	1			5	7
41			1	X	1	1	X	1	X	X	2	1	1	1	1	X			9
42			1	2	1	1	1	1	X	1	X	X	1	X	2	2			2	12
43			X	1	1	1	1	1	1	1	2	1	2	2	1	X			8	3
44			2	X	X	1	1	X	1	1	X	X	X	X	1	X
45			X	2	1	1	X	1	1	2	1	1	1	1	2	1			6	5
46			1	X	X	1	1	1	1	1	1	1	X	1	1	X
47			X	X	1	1	1	X	X	2	1	1	1	1	X	X			6
48			1	1	1	X	1	X	1	1	1	1	X	1	1	1
49			X	X	1	1	X	1	1	1	1	1	1	1	1	1
50			1	1	1	X	1	1	1	1	2	1	1	X	1	1			9
51			1	1	1	1	1	X	X	1	X	2	X	X	X	X			10
52			1	1	1	1	2	1	X	X	X	1	1	1	1	1			5
53			2	X	1	1	X	1	1	X	X	1	1	1	1	2			12
54			1	X	X	1	1	1	1	1	1	2	1	2	1	2			10	2	2
55			1	1	1	1	X	1	1	X	X	X	1	1	X	1
56			X	1	1	1	X	1	2	1	1	1	2	X	1	1			6	4
57			1	1	X	X	1	X	1	1	X	X	X	2	1	1			12
58			1	2	2	1	1	1	X	2	1	X	X	X	1	X			3	5
59			1	1	X	1	1	2	1	1	1	1	X	1	X	1			6
60			1	2	2	1	1	X	1	1	1	1	1	X	1	X			3
61			2	1	X	1	X	1	1	1	1	2	2	X	2	X			10
62			2	2	2	1	1	2	1	1	1	1	2	X	2	X			3	5
63			X	1	2	1	1	X	1	1	2	1	2	1	1	1			2	3	2
64			X	X	X	1	1	1	2	2	1	1	1	2	2	1			5	5
65			X	X	2	X	X	2	X	1	2	2	1	2	2	X			3	3
66			1	1	1	1	X	1	1	X	2	1	2	1	2	1			9	2	2
67			X	1	2	1	2	2	1	2	1	1	2	X	1	1			2	3	2	3
68			X	X	1	2	2	2	1	1	1	X	2	1	1	X			4	5
69			2	X	2	1	2	X	X	1	2	2	X	X	X	X			2	3
70			2	2	X	X	1	X	1	1	1	1	1	X	1	X
71			2	1	X	1	2	2	2	2	2	1	X	2	1	X			8	3
72			2	1	2	1	1	X	1	1	2	X	1	2	X	1			2	6	2
73			2	X	2	2	1	1	1	X	1	1	1	1	X	1
74			1	X	X	1	2	X	1	2	1	1	1	2	2	1			5	2	5
75			2	X	1	1	1	X	1	1	1	X	2	1	1	1			9
76			2	1	1	1	X	X	1	X	X	1	1	1	2	X			12
77			X	2	1	2	2	X	1	1	2	2	2	1	1	1			3	5
78			2	1	1	X	2	1	1	X	2	X	2	2	2	X			4	4
79			X	1	1	2	X	1	2	1	1	1	1	1	1	X			3	2
80			1	2	1	2	X	2	1	X	1	2	X	1	1	1			2	2	4
81			2	X	X	1	2	2	1	1	1	2	1	1	1	X			3	4
82			1	1	1	1	2	1	1	1	2	1	2	1	X	X			5	4	2
83			1	2	1	2	1	1	1	2	2	1	2	1	1	X			2	2	5	2
84
85
Sheet10

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

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

 

[Yongle]

one way

Sub CountDistance()
Application.ScreenUpdating = False
Dim rng As Range, r As Long, c As Long, c1 As Range, c2 As Range, myStr As String, theCount As Integer
Set rng = Range("C5").CurrentRegion
For r = 2 To rng.Rows.Count
    For c = 1 To rng.Columns.Count
        Select Case c1 Is Nothing
            Case True: If rng(r, c) = 1 Then Set c1 = rng(r, c)
            Case Else: If rng(r, c) = 2 And rng(r, c + 1) <> 2 Then Set c2 = rng(r, c)
        End Select

        Select Case c2 Is Nothing
            Case False
                theCount = c2.Column - c1.Column + 1
                If myStr = "" Then myStr = theCount Else myStr = myStr & "," & theCount
                Set c1 = Nothing: Set c2 = Nothing
        End Select
    Next c
    
    Range("S" & rng(r, c).Row) = myStr: myStr = ""
    Set c1 = Nothing: Set c2 = Nothing
Next r

Range("S" & rng(2, 1).Row).Resize(rng.Rows.Count - 1).TextToColumns Destination:=Range("S6"), DataType:=xlDelimited, Comma:=True
End Sub

 

[Kishan]

one way

Sub CountDistance()
Application.ScreenUpdating = False
Dim rng As Range, r As Long, c As Long, c1 As Range, c2 As Range, myStr As String, theCount As Integer
Set rng = Range("C5").CurrentRegion
For r = 2 To rng.Rows.Count
    For c = 1 To rng.Columns.Count
        Select Case c1 Is Nothing
            Case True: If rng(r, c) = 1 Then Set c1 = rng(r, c)
            Case Else: If rng(r, c) = 2 And rng(r, c + 1) <> 2 Then Set c2 = rng(r, c)
        End Select

        Select Case c2 Is Nothing
            Case False
                theCount = c2.Column - c1.Column + 1
                If myStr = "" Then myStr = theCount Else myStr = myStr & "," & theCount
                Set c1 = Nothing: Set c2 = Nothing
        End Select
    Next c
    
    Range("S" & rng(r, c).Row) = myStr: myStr = ""
    Set c1 = Nothing: Set c2 = Nothing
Next r

Range("S" & rng(2, 1).Row).Resize(rng.Rows.Count - 1).TextToColumns Destination:=Range("S6"), DataType:=xlDelimited, Comma:=True
End Sub

Thank you Yongle, for your kind help!! Yes your code is resulting as request it is just perfect!!</SPAN></SPAN>

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

 

[Yongle]

thanks for feedback

 

[Kishan]

Using Excel 2000</SPAN></SPAN>

Hi,</SPAN></SPAN>

Note Optional request: if possible could be highlighted columns C:P as shown </SPAN></SPAN>

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

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

The principal request is solved, need help for the optional request if could be

Optional request: if possible could be highlighted columns C:P as show in post#1

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

Regards,</SPAN>
Kishan


</SPAN>

 

[MickG]

Another option for Numbers and colours !!!

[COLOR="Navy"]Sub[/COLOR] MG25Aug42
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, ac [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] col [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] cls [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("c6"), Range("c" & Rows.Count).End(xlUp))
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
c = 0: col = 15
    [COLOR="Navy"]For[/COLOR] ac = 1 To 14
        [COLOR="Navy"]If[/COLOR] Dn(, ac) = 1 [COLOR="Navy"]Then[/COLOR] [COLOR="Navy"]If[/COLOR] c = 0 [COLOR="Navy"]Then[/COLOR] c = ac
        [COLOR="Navy"]If[/COLOR] c > 0 And Dn(, ac) = 2 And Not Dn(, ac + 1) = 2 [COLOR="Navy"]Then[/COLOR]
            col = col + 1
            Dn.Offset(, col) = ac - c + 1
            cls = IIf(cls = vbRed, vbGreen, vbRed)
            Dn.Offset(, c - 1).Resize(, ac - c + 1).Interior.Color = cls
            c = 0
        [COLOR="Navy"]End[/COLOR] If
    [COLOR="Navy"]Next[/COLOR] ac
[COLOR="Navy"]Next[/COLOR] Dn
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[Kishan]

Another option for Numbers and colours !!!

[COLOR=navy]Sub[/COLOR] MG25Aug42
[COLOR=navy]Dim[/COLOR] Rng [COLOR=navy]As[/COLOR] Range, Dn [COLOR=navy]As[/COLOR] Range, ac [COLOR=navy]As[/COLOR] [COLOR=navy]Long,[/COLOR] col [COLOR=navy]As[/COLOR] [COLOR=navy]Long,[/COLOR] c [COLOR=navy]As[/COLOR] [COLOR=navy]Long,[/COLOR] cls [COLOR=navy]As[/COLOR] [COLOR=navy]Long[/COLOR]
[COLOR=navy]Set[/COLOR] Rng = Range(Range("c6"), Range("c" & Rows.Count).End(xlUp))
[COLOR=navy]For[/COLOR] [COLOR=navy]Each[/COLOR] Dn [COLOR=navy]In[/COLOR] Rng
c = 0: col = 15
    [COLOR=navy]For[/COLOR] ac = 1 To 14
        [COLOR=navy]If[/COLOR] Dn(, ac) = 1 [COLOR=navy]Then[/COLOR] [COLOR=navy]If[/COLOR] c = 0 [COLOR=navy]Then[/COLOR] c = ac
        [COLOR=navy]If[/COLOR] c > 0 And Dn(, ac) = 2 And Not Dn(, ac + 1) = 2 [COLOR=navy]Then[/COLOR]
            col = col + 1
            Dn.Offset(, col) = ac - c + 1
            cls = IIf(cls = vbRed, vbGreen, vbRed)
            Dn.Offset(, c - 1).Resize(, ac - c + 1).Interior.Color = cls
            c = 0
        [COLOR=navy]End[/COLOR] If
    [COLOR=navy]Next[/COLOR] ac
[COLOR=navy]Next[/COLOR] Dn
[COLOR=navy]End[/COLOR] [COLOR=navy]Sub[/COLOR]

Regards Mick

Excellent!! Mick, for giving a 2 in 1 solution, I liked!! It very much </SPAN></SPAN>

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

 

[MickG]

You're very welcome

 

[Kishan]

Please Mick, may I ask, could you make a small piece of a modification? </SPAN></SPAN>

Count results in the columns S:AF could be placed by there 1's position find in the column C:P</SPAN></SPAN>

For example: row 6 first 1&2-count start in D6 in position 2, so result in T6, </SPAN></SPAN>
Second 1&2-count starts in F6 in position 4, so result in V6,</SPAN></SPAN>
Third 1&2-count starts in J6 in position 4, so result in Z6,</SPAN></SPAN>
Firth 1&2-count starts in N6 in position 4, so result in AD6,</SPAN></SPAN>

Result Example:</SPAN></SPAN>

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			C1	C2	C3	C4	C5	C6	C7	C8	C9	C10	C11	C12	C13	C14			C1	C2	C3	C4	C5	C6	C7	C8	C9	C10	C11	C12	C13	C14
6			X	1	2	1	2	X	X	1	1	2	X	1	1	2				2		2				3				3
7			1	X	2	2	2	1	X	X	2	2	X	X	1	1			5					5
8			1	X	1	1	X	X	2	2	X	X	1	1	X	X			8
9			1	X	1	2	2	1	X	1	1	X	1	2	2	1			5					8
10			X	1	X	1	X	1	1	X	1	1	1	X	X	1
11			X	X	X	1	1	1	1	X	1	X	2	1	2	X						8								2
12			2	X	1	1	1	2	X	X	X	1	1	1	2	1					4							4
13			X	1	X	X	1	1	1	1	1	1	1	X	1	1
14			1	X	X	1	2	1	2	1	1	1	2	X	2	X			5					2		4
15			X	2	X	1	1	X	1	1	1	1	X	1	1	X
16			1	1	1	1	1	1	X	X	X	1	1	1	2	X			13
17			1	2	1	2	X	1	1	2	X	2	1	1	1	X			2		2			3
18			1	X	X	1	1	2	X	X	1	X	1	1	X	1			6
19			1	X	X	1	1	2	1	1	2	2	1	X	1	1			6						4
20			1	1	1	X	1	1	1	1	X	1	1	1	1	1
21			X	1	2	X	1	1	1	2	X	1	1	2	X	X				2			4					3
22			1	1	1	X	1	X	X	1	X	1	1	1	1	1
23			1	1	1	1	1	X	X	2	1	1	1	1	1	2			8								6
24			1	1	1	1	1	1	1	1	1	1	2	X	X	1			11
25			1	2	2	1	1	1	1	1	1	1	1	X	1	1			3
26			1	1	X	1	1	1	1	1	1	1	1	1	2	1			13
27			X	X	X	1	1	1	X	1	1	2	X	1	1	1			8
28			X	2	1	1	2	1	1	1	1	1	X	X	1	X			3
29			1	X	2	2	1	1	1	2	X	X	1	1	1	X			4				4
30			2	1	X	X	1	1	X	X	1	X	1	1	1	1
31			1	X	1	2	2	1	1	1	1	2	1	1	1	X			5					5
32			1	1	X	1	2	2	2	1	1	X	1	X	1	X			7
33			2	1	X	1	X	1	X	1	1	1	1	1	1	1
34			X	1	1	1	1	1	2	1	2	X	X	1	X	X				6						2
35			1	2	1	1	X	1	1	1	X	2	X	1	X	X			2		8
36			X	1	1	1	1	X	1	2	1	1	X	1	X	X			7
37			2	X	1	1	1	X	X	1	1	X	1	1	X	1
38			1	X	2	X	1	X	1	1	1	1	1	2	1	X			3				8
39			X	1	X	X	1	X	1	1	X	1	2	2	1	1				11
40			1	X	X	1	2	X	1	1	X	1	X	1	2	1			5						7
41			1	X	1	1	X	1	X	X	2	1	1	1	1	X			9
42			1	2	1	1	1	1	X	1	X	X	1	X	2	2			2		12
43			X	1	1	1	1	1	1	1	2	1	2	2	1	X				8								3
44			2	X	X	1	1	X	1	1	X	X	X	X	1	X
45			X	2	1	1	X	1	1	2	1	1	1	1	2	1					6						5
46			1	X	X	1	1	1	1	1	1	1	X	1	1	X
47			X	X	1	1	1	X	X	2	1	1	1	1	X	X			6
48			1	1	1	X	1	X	1	1	1	1	X	1	1	1
49			X	X	1	1	X	1	1	1	1	1	1	1	1	1
50			1	1	1	X	1	1	1	1	2	1	1	X	1	1			9
51			1	1	1	1	1	X	X	1	X	2	X	X	X	X			10
52			1	1	1	1	2	1	X	X	X	1	1	1	1	1			5
53			2	X	1	1	X	1	1	X	X	1	1	1	1	2					12
54			1	X	X	1	1	1	1	1	1	2	1	2	1	2			10										2		2
55			1	1	1	1	X	1	1	X	X	X	1	1	X	1
56			X	1	1	1	X	1	2	1	1	1	2	X	1	1				6						4
57			1	1	X	X	1	X	1	1	X	X	X	2	1	1			12
58			1	2	2	1	1	1	X	2	1	X	X	X	1	X			3			5
59			1	1	X	1	1	2	1	1	1	1	X	1	X	1			6
60			1	2	2	1	1	X	1	1	1	1	1	X	1	X			3
61
62
Sheet10

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

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

 

[MickG]

Try this:-

[COLOR="Navy"]Sub[/COLOR] MG26Aug12
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, ac [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] col [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] cls [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("c6"), Range("c" & Rows.Count).End(xlUp))
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
c = 0: col = 15
    [COLOR="Navy"]For[/COLOR] ac = 1 To 14
        [COLOR="Navy"]If[/COLOR] Dn(, ac) = 1 [COLOR="Navy"]Then[/COLOR] [COLOR="Navy"]If[/COLOR] c = 0 [COLOR="Navy"]Then[/COLOR] c = ac
        [COLOR="Navy"]If[/COLOR] c > 0 And Dn(, ac) = 2 And Not Dn(, ac + 1) = 2 [COLOR="Navy"]Then[/COLOR]
            Dn.Offset(, col + c) = ac - c + 1
            cls = IIf(cls = vbRed, vbGreen, vbRed)
            Dn.Offset(, c - 1).Resize(, ac - c + 1).Interior.Color = cls
            c = 0
        [COLOR="Navy"]End[/COLOR] If
    [COLOR="Navy"]Next[/COLOR] ac
[COLOR="Navy"]Next[/COLOR] Dn
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick