Check cycle of character 1X2

Kishan

Well-known Member
Joined
Mar 15, 2011
Messages
1,645
Office Version
  1. 2010
Platform
  1. Windows
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
ABCDE
1
2
3
4
5P1
6X
71
8X
92
101
11X
121
131
14X
151
161
171
181
191
20214
211
221
231
241
251
261
271
28X
291
301
311
32X
331
342
35X
361
37X
38X
391
401
411
421
431
441
45X
461
471
48X28
491
501
511
521
531
54X
55X
56X
571
58X
591
601
611
621
631
64X
651
661
671
681
69221
701
711
721
731
741
751
761
771
78X
79
80
81
82
83
Sheet1


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

Regards,</SPAN>
Kishan</SPAN>
 
Last edited:
Okay, I think I got it. Give this macro a try...
Code:
[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]
 
Upvote 0

Excel Facts

Waterfall charts in Excel?
Office 365 customers have access to Waterfall charts since late 2016. They were added to Excel 2019.
Okay, I think I got it. Give this macro a try...
Code:
[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.
:pray:

Have a beautiful weekend

Good Luck Rick

Regards,
Kishan
:)
 
Upvote 0

Forum statistics

Threads
1,213,527
Messages
6,114,150
Members
448,552
Latest member
WORKINGWITHNOLEADER

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top