Count the period once cycle is completed

[Kishan]

Hi,

This query is bit complicated I will try my best to explain it

Data are located in cells C6:I82 what I need to check cycle for 1, X & 2 among the 7 columns C through I one by one and count the max numbers where the cycle is completed within the 7 column and the count result show in column J

For example...

1st cycle of 1, X, 2 has been completed with in 27 periods in column I so far result in Cell I32 = 27

2nd cycle of 1, X, 2 has been completed with in 30 periods in column G so far result in Cell J62 = 30

And continue finding...

Column K shows only the summary of cycle counts.

Colours are filled just to shown to show example bit clearer.

Example data...

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

Thank you in advance

Kishan

 

[MickG]

Re: Count the period once cycle is completed tricky one

Try this for basic result in column "K" :-

[COLOR="Navy"]Sub[/COLOR] MG13Sep39
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Rw [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Lr [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Ac [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] Fd1 [COLOR="Navy"]As[/COLOR] Boolean, Fd2 [COLOR="Navy"]As[/COLOR] Boolean, Fd3 [COLOR="Navy"]As[/COLOR] Boolean, oMax [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] nLt [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Lst [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
Lst = Range("c" & Rows.Count).End(xlUp).Row
Rw = 5: Lr = 5
[COLOR="Navy"]Do[/COLOR] [COLOR="Navy"]While[/COLOR] Lr < Lst
    [COLOR="Navy"]Set[/COLOR] Rng = Range(Cells(Lr + 1, 3), Cells(Rows.Count, 3).End(xlUp))
        [COLOR="Navy"]For[/COLOR] Ac = 0 To 6
            [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
                n = n + 1
                [COLOR="Navy"]If[/COLOR] Not Fd1 And Dn.Offset(, Ac).Value = "X" [COLOR="Navy"]Then[/COLOR] Fd1 = True: c = c + 1
                [COLOR="Navy"]If[/COLOR] Not Fd2 And Dn.Offset(, Ac).Value = 1 [COLOR="Navy"]Then[/COLOR] Fd2 = True: c = c + 1
                [COLOR="Navy"]If[/COLOR] Not Fd3 And Dn.Offset(, Ac).Value = 2 [COLOR="Navy"]Then[/COLOR] Fd3 = True: c = c + 1
                [COLOR="Navy"]If[/COLOR] c = 3 [COLOR="Navy"]Then[/COLOR]
                    Fd1 = False: Fd2 = False: Fd3 = False
                    oMax = Application.Max(oMax, n)
                    n = 0: c = 0
                    Lr = Application.Max(Dn.Row, Lr)
                    [COLOR="Navy"]Exit[/COLOR] For
                [COLOR="Navy"]End[/COLOR] If
          [COLOR="Navy"]Next[/COLOR] Dn
            [COLOR="Navy"]If[/COLOR] c > 0 And c < 3 [COLOR="Navy"]Then[/COLOR] [COLOR="Navy"]Exit[/COLOR] [COLOR="Navy"]Sub[/COLOR]
     [COLOR="Navy"]Next[/COLOR] Ac
        Rw = Rw + 1
        Cells(Rw, "K") = oMax: oMax = 0
Loop
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[Kishan]

Re: Count the period once cycle is completed tricky one

Try this for basic result in column "K" :-

[COLOR=navy]Sub[/COLOR] MG13Sep39
[COLOR=navy]Dim[/COLOR] Rng [COLOR=navy]As[/COLOR] Range, Dn [COLOR=navy]As[/COLOR] Range, c [COLOR=navy]As[/COLOR] [COLOR=navy]Long,[/COLOR] n [COLOR=navy]As[/COLOR] [COLOR=navy]Long,[/COLOR] Rw [COLOR=navy]As[/COLOR] [COLOR=navy]Long,[/COLOR] Lr [COLOR=navy]As[/COLOR] [COLOR=navy]Long,[/COLOR] Ac [COLOR=navy]As[/COLOR] [COLOR=navy]Long[/COLOR]
[COLOR=navy]Dim[/COLOR] Fd1 [COLOR=navy]As[/COLOR] Boolean, Fd2 [COLOR=navy]As[/COLOR] Boolean, Fd3 [COLOR=navy]As[/COLOR] Boolean, oMax [COLOR=navy]As[/COLOR] [COLOR=navy]Long,[/COLOR] nLt [COLOR=navy]As[/COLOR] [COLOR=navy]Long,[/COLOR] Lst [COLOR=navy]As[/COLOR] [COLOR=navy]Long[/COLOR]
Lst = Range("c" & Rows.Count).End(xlUp).Row
Rw = 5: Lr = 5
[COLOR=navy]Do[/COLOR] [COLOR=navy]While[/COLOR] Lr < Lst
    [COLOR=navy]Set[/COLOR] Rng = Range(Cells(Lr + 1, 3), Cells(Rows.Count, 3).End(xlUp))
        [COLOR=navy]For[/COLOR] Ac = 0 To 6
            [COLOR=navy]For[/COLOR] [COLOR=navy]Each[/COLOR] Dn [COLOR=navy]In[/COLOR] Rng
                n = n + 1
                [COLOR=navy]If[/COLOR] Not Fd1 And Dn.Offset(, Ac).Value = "X" [COLOR=navy]Then[/COLOR] Fd1 = True: c = c + 1
                [COLOR=navy]If[/COLOR] Not Fd2 And Dn.Offset(, Ac).Value = 1 [COLOR=navy]Then[/COLOR] Fd2 = True: c = c + 1
                [COLOR=navy]If[/COLOR] Not Fd3 And Dn.Offset(, Ac).Value = 2 [COLOR=navy]Then[/COLOR] Fd3 = True: c = c + 1
                [COLOR=navy]If[/COLOR] c = 3 [COLOR=navy]Then[/COLOR]
                    Fd1 = False: Fd2 = False: Fd3 = False
                    oMax = Application.Max(oMax, n)
                    n = 0: c = 0
                    Lr = Application.Max(Dn.Row, Lr)
                    [COLOR=navy]Exit[/COLOR] For
                [COLOR=navy]End[/COLOR] If
          [COLOR=navy]Next[/COLOR] Dn
            [COLOR=navy]If[/COLOR] c > 0 And c < 3 [COLOR=navy]Then[/COLOR] [COLOR=navy]Exit[/COLOR] [COLOR=navy]Sub[/COLOR]
     [COLOR=navy]Next[/COLOR] Ac
        Rw = Rw + 1
        Cells(Rw, "K") = oMax: oMax = 0
Loop
[COLOR=navy]End[/COLOR] [COLOR=navy]Sub[/COLOR]

Regards Mick

Thank you MickG, this is giving perfect result for summary count cycle in the column K. now I need a code for post#4 & for post#8 if possible

Thank you for your help

Kind Regards,
Kishan

 

[mrmmickle1]

Re: Count the period once cycle is completed tricky one

What about this more user friendly UDF:

Function CycleCount(myRange As Range)
    
    Dim ColStart As Integer
    Dim Colstop As Integer
    Dim RowStart As Integer
    Dim RowStop As Integer
    Dim RowLp As Integer
    Dim ColLp As Integer
    Dim CyclecountFinal As Integer
    Dim PrevCycleCountVal As Integer
    Dim myVar As String
    
    RowStart = myRange.Row
    RowStop = myRange.Rows.Count + myRange.Row - 1
    ColStart = myRange.Column
    Colstop = myRange.Columns.Count + myRange.Column - 1
    
    For ColLp = ColStart To Colstop
        For RowLp = RowStart To RowStop
            myVar = myVar & Cells(RowLp, ColLp) 'Concatenate all of the values together
        Next RowLp
            X = InStr(1, myVar, "X"): One = InStr(1, myVar, "1"): Two = InStr(1, myVar, "2") 'Define First Row containing each string
            myRow = Application.Max(X, One, Two) 'Get Max Row
                If myRow > PrevCycleCountVal Then
                    CyclecountFinal = myRow 'Overwrite value if new column has greater value
                Else
                    'Do Nothing if number is not larger....
                End If
            PrevCycleCountVal = myRow
            myVar = vbNullString
    Next ColLp
    
    CycleCount = CyclecountFinal


End Function

Now all you have to do is input the range into the function.... i.e. :

Worksheet Formulas Cell Formula N6 =Cyclecount(C6:I32) N7 =Cyclecount(C33:I62) N8 =Cyclecount(C63:I82) <thead> </thead><tbody> </tbody>

<tbody>
</tbody>

 

[Kishan]

Re: Count the period once cycle is completed tricky one

Try something like this UDF :

Use it in a worksheet formula like this:

=CycleCount(3,9,6,32) This will yield 27

Hi mrmmickle, I appreciate your help my query is I do want to find the cycle range, if I know the range than I can get the answer putting the formula in N6 =ROW(J32)-ROW(J6)+1.
So far the question is find the range after the cycle is completed in all the 7 columns C through J.

Thank you for your help

Kind Regards,
Kishan

 

[Eric W]

Re: Count the period once cycle is completed tricky one

I could probably make this a bit more efficient, but it seems to do the trick:

Sub GetCounts()
Dim counts(1 To 3, 1 To 7) As Long, r As Long, ctr As Long, r2 As Long, i as Long

    r = 6
    ctr = 0
    r2 = 6
    While Cells(r, "C") <> ""
        For i = 1 To 7
            If Cells(r, i + 2) = 1 Then counts(1, i) = 1
            If Cells(r, i + 2) = 2 Then counts(2, i) = 1
            If Cells(r, i + 2) = "X" Then counts(3, i) = 1
        Next i
        ctr = ctr + 1
        If WorksheetFunction.Product(counts) > 0 Then
            Cells(r, "J") = ctr
            Cells(r2, "K") = ctr
            r2 = r2 + 1
            ctr = 0
            Erase counts
        End If
        r = r + 1
    Wend
    
End Sub

Install this code, and open a copy of your workbook to the proper sheet, then run it.

 

[Kishan]

Re: Count the period once cycle is completed tricky one

I could probably make this a bit more efficient, but it seems to do the trick:

Sub GetCounts()
Dim counts(1 To 3, 1 To 7) As Long, r As Long, ctr As Long, r2 As Long, i as Long

    r = 6
    ctr = 0
    r2 = 6
    While Cells(r, "C") <> ""
        For i = 1 To 7
            If Cells(r, i + 2) = 1 Then counts(1, i) = 1
            If Cells(r, i + 2) = 2 Then counts(2, i) = 1
            If Cells(r, i + 2) = "X" Then counts(3, i) = 1
        Next i
        ctr = ctr + 1
        If WorksheetFunction.Product(counts) > 0 Then
            Cells(r, "J") = ctr
            Cells(r2, "K") = ctr
            r2 = r2 + 1
            ctr = 0
            Erase counts
        End If
        r = r + 1
    Wend
    
End Sub

Install this code, and open a copy of your workbook to the proper sheet, then run it.

Amazing!! Eric W, speechless, no words small piece of code but very fast and accurate results. Truly I like the code very much. This is solved as request in the opening post#1.

In the post#4 you suggest the formula and resolve this in a different way. The way you suggest I find it usefully which gives some information in the column L:R that I haven't even thought that 1st cycle is complete period of 27 in the column.

Please could you make a code that works with a post#4 and give the additional information in columns L:R as you suggested.

Thank you so much for your kind help

Kind Regards,
Kishan

 

[Eric W]

Re: Count the period once cycle is completed tricky one

Glad it works for you.

Consider this update that shows the totals in L:R

Sub GetCounts()
Dim counts(1 To 3, 1 To 7) As Long, r As Long, ctr As Long, r2 As Long, Cx(1 To 1, 1 To 7) As Long

    Application.ScreenUpdating = False
    
    Range("J:R").ClearContents
    Range("K5:R5") = Array("Count Cycle", "C1", "C2", "C3", "C4", "C5", "C6", "C7")
    r = 6
    ctr = 0
    r2 = 6
    Erase counts, Cx
    While Cells(r, "C") <> ""
        ctr = ctr + 1
        For i = 1 To 7
            If Cells(r, i + 2) = 1 Then counts(1, i) = 1
            If Cells(r, i + 2) = 2 Then counts(2, i) = 1
            If Cells(r, i + 2) = "X" Then counts(3, i) = 1
            If Cx(1, i) = 0 And counts(1, i) * counts(2, i) * counts(3, i) > 0 Then Cx(1, i) = ctr
        Next i
        If WorksheetFunction.Product(counts) > 0 Then
            Cells(r, "J") = ctr
            Cells(r2, "K") = ctr
            Range(Cells(r2, "L"), Cells(r2, "R")).Value = Cx
            r2 = r2 + 1
            ctr = 0
            Erase counts, Cx
        End If
        r = r + 1
    Wend
    
    Application.ScreenUpdating = True
    
End Sub

 

[Kishan]

Re: Count the period once cycle is completed tricky one

Glad it works for you.

Consider this update that shows the totals in L:R

Sub GetCounts()
Dim counts(1 To 3, 1 To 7) As Long, r As Long, ctr As Long, r2 As Long, Cx(1 To 1, 1 To 7) As Long

    Application.ScreenUpdating = False
    
    Range("J:R").ClearContents
    Range("K5:R5") = Array("Count Cycle", "C1", "C2", "C3", "C4", "C5", "C6", "C7")
    r = 6
    ctr = 0
    r2 = 6
    Erase counts, Cx
    While Cells(r, "C") <> ""
        ctr = ctr + 1
        For i = 1 To 7
            If Cells(r, i + 2) = 1 Then counts(1, i) = 1
            If Cells(r, i + 2) = 2 Then counts(2, i) = 1
            If Cells(r, i + 2) = "X" Then counts(3, i) = 1
            If Cx(1, i) = 0 And counts(1, i) * counts(2, i) * counts(3, i) > 0 Then Cx(1, i) = ctr
        Next i
        If WorksheetFunction.Product(counts) > 0 Then
            Cells(r, "J") = ctr
            Cells(r2, "K") = ctr
            Range(Cells(r2, "L"), Cells(r2, "R")).Value = Cx
            r2 = r2 + 1
            ctr = 0
            Erase counts, Cx
        End If
        r = r + 1
    Wend
    
    Application.ScreenUpdating = True
    
End Sub

Wow!! Eric W, code works like a dream it is just fantastic!!

I am Glad to have it. Thank you very much

I appreciate a lot your kind help

Kind Regards,
Kishan

 

[Kishan]

Re: Count the period once cycle is completed tricky one

Hi,

I need one additional help with post#17 macro which is working as request all the way perfect!!

I desire if it could be added the colour option that can fill the cells only with single colour yellow for all 3 sections as shown in the post#1 (not as shown in the example post#1 with 3 different colours) will be huge help of you.

Thank you

Kind Regards,
Kishan

 

[Eric W]

Try adding the lines in red:

Sub GetCounts()
Dim counts(1 To 3, 1 To 7) As Long, r As Long, ctr As Long, r2 As Long, Cx(1 To 1, 1 To 7) As Long


    Application.ScreenUpdating = False
    
    Range("C:I").Interior.ColorIndex = xlNone
    Range("J:R").ClearContents
    Range("K5:R5") = Array("Count Cycle", "C1", "C2", "C3", "C4", "C5", "C6", "C7")
    r = 6
    ctr = 0
    r2 = 6
    Erase counts, Cx
    While Cells(r, "C") <> ""
        ctr = ctr + 1
        For i = 1 To 7
            If Cells(r, i + 2) = 1 Then counts(1, i) = 1
            If Cells(r, i + 2) = 2 Then counts(2, i) = 1
            If Cells(r, i + 2) = "X" Then counts(3, i) = 1
            If Cx(1, i) = 0 And counts(1, i) * counts(2, i) * counts(3, i) > 0 Then Cx(1, i) = ctr
        Next i
        If WorksheetFunction.Product(counts) > 0 Then
            Cells(r, "J") = ctr
            Cells(r2, "K") = ctr
            Range(Cells(r2, "L"), Cells(r2, "R")).Value = Cx
            r2 = r2 + 1
            ctr = 0
            Erase counts, Cx
        End If
        r = r + 1
    Wend
    
    r = 6
    r2 = 6
    While Cells(r, "K") <> ""
        For i = 1 To 7
            Cells(r2, i + 2).Resize(Cells(r, i + 11)).Interior.Color = vbYellow
        Next i
        r2 = r2 + Cells(r, "K").Value
        r = r + 1
    Wend

    Application.ScreenUpdating = True
    
End Sub