Check cycle of character 1X2

[Kishan]

Using Excel 2000</SPAN></SPAN>

Hi,</SPAN></SPAN>

Data cells C6:C78, highlighted every 7th row with black background-white fonts, my query is I need to check cycle for 3 characters 1X2 when it is completed.</SPAN></SPAN>

For the example...</SPAN></SPAN>

C6=X, C13=1, C20=2, so far cycle of 1X2 is completed starting from C6 within 14 rows, so far RESULT in row D20=14 </SPAN></SPAN>

C27=1, C34=2, C41=1(repeated), C48=X, so far next cycle of 1X2 is completed starting from C20 within 28 rows, so far RESULT in row D48=28</SPAN></SPAN>

And so on...</SPAN></SPAN>

Example sample data</SPAN></SPAN>

Book1
	A	B	C	D	E
1
2
3
4
5			P1
6			X
7			1
8			X
9			2
10			1
11			X
12			1
13			1
14			X
15			1
16			1
17			1
18			1
19			1
20			2	14
21			1
22			1
23			1
24			1
25			1
26			1
27			1
28			X
29			1
30			1
31			1
32			X
33			1
34			2
35			X
36			1
37			X
38			X
39			1
40			1
41			1
42			1
43			1
44			1
45			X
46			1
47			1
48			X	28
49			1
50			1
51			1
52			1
53			1
54			X
55			X
56			X
57			1
58			X
59			1
60			1
61			1
62			1
63			1
64			X
65			1
66			1
67			1
68			1
69			2	21
70			1
71			1
72			1
73			1
74			1
75			1
76			1
77			1
78			X
79
80
81
82
83
Sheet1

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

Regards,</SPAN>
Kishan</SPAN>

 

[Rick Rothstein]

Okay, I think I got it. Give this macro a try...

[table="width: 500"]
[tr]
	[td]Sub X12cycle()
  Dim r As Long, LastRow As Long, CntRow As Long
  Dim X12 As String, ACell As Range, Data As Variant
  X12 = "---"
  CntRow = 6
  LastRow = Cells(Rows.Count, "C").End(xlUp).Row
  '  Beginning of cell coloring code
  Set ACell = ActiveCell
  Range("C5").Interior.Color = vbCyan
  Range("C5:C" & LastRow).Font.Color = vbBlack
  Range("C13").Interior.Color = vbBlack
  Range("C13").Font.Color = vbWhite
  Range("C7").Resize(6).Interior.Color = vbGreen
  Range("C7:C13").Copy
  Range("C14:C" & LastRow).PasteSpecial xlPasteFormats
  ACell.Select
  '  End of cell coloring code
  Range("C5:C" & LastRow).HorizontalAlignment = xlCenter
  Data = Range("C1:C" & LastRow).Value
  Range("D27", Cells(Rows.Count, "D").End(xlUp)).ClearContents
  For r = 13 To LastRow Step 7
    Mid(X12, InStr("X12", Data(r, 1))) = Data(r, 1)
    If X12 = "X12" Then
      Cells(r, "D").Value = r - CntRow
      Cells(r, "D").Font.Color = vbRed
      CntRow = r
      X12 = "---"
    End If
  Next
End Sub[/td]
[/tr]
[/table]

 

[Kishan]

Okay, I think I got it. Give this macro a try...

[TABLE="width: 500"]
<tbody>[TR]
[TD]Sub X12cycle()
  Dim r As Long, LastRow As Long, CntRow As Long
  Dim X12 As String, ACell As Range, Data As Variant
  X12 = "---"
  CntRow = 6
  LastRow = Cells(Rows.Count, "C").End(xlUp).Row
  '  Beginning of cell coloring code
  Set ACell = ActiveCell
  Range("C5").Interior.Color = vbCyan
  Range("C5:C" & LastRow).Font.Color = vbBlack
  Range("C13").Interior.Color = vbBlack
  Range("C13").Font.Color = vbWhite
  Range("C7").Resize(6).Interior.Color = vbGreen
  Range("C7:C13").Copy
  Range("C14:C" & LastRow).PasteSpecial xlPasteFormats
  ACell.Select
  '  End of cell coloring code
  Range("C5:C" & LastRow).HorizontalAlignment = xlCenter
  Data = Range("C1:C" & LastRow).Value
  Range("D27", Cells(Rows.Count, "D").End(xlUp)).ClearContents
  For r = 13 To LastRow Step 7
    Mid(X12, InStr("X12", Data(r, 1))) = Data(r, 1)
    If X12 = "X12" Then
      Cells(r, "D").Value = r - CntRow
      Cells(r, "D").Font.Color = vbRed
      CntRow = r
      X12 = "---"
    End If
  Next
End Sub[/TD]
[/TR]
</tbody>[/TABLE]

Speechless Rick, 435 views it says all, that it was not an easy project.

Checked fully, with my original data more than 9000 + rows, it worked like a magic. I see you like the challenging assignment. This has been one must difficult one for me.

Rick heartily thank to you for solving my project, thank you for spending your valuable time and giving a spot solution. ray:

Have a beautiful weekend

Good Luck Rick

Regards,
Kishan