Count the period once cycle is completed

Kishan

Well-known Member
Joined
Mar 15, 2011
Messages
1,648
Office Version
  1. 2010
Platform
  1. Windows
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
ABCDEFGHIJKL
1
2
3
4Summary
5C1C2C3C4C5C6C7Count Cycle
6X1112XX27
7X2X121130
8X1112XX15
92111121
1011111X1
11XXX1211
12X11211X
131XX112X
1411X1XXX
151X11X1X
16XX2XX1X
171X1111X
1811X1121
19X11112X
20111X12X
21111X12X
222XX1121
23112121X
24X1111X1
251111111
26X121XXX
271XX2111
28112XXX1
291111X1X
30111X111
311111111
32111XXX227
33211212X
34111111X
3521XXX1X
361X1X112
37X11112X
38X1X1121
39X21XXX1
40111X12X
41XXX1111
4222111X2
43X111112
44X111X11
451X21111
46112111X
47211X11X
481111111
49XX11X22
50X1X1111
51XXXX1X1
52X1X1112
53X1X111X
542XXX1X2
55X212112
561222XX2
57XX1112X
581XX1XX1
591X11111
602X111X1
61X21X111
62212122130
6311111X1
6412121X1
65111X111
66XX11111
67X22X112
681211X11
69X11211X
7011111XX
711121XX1
721XX1112
7311X2X11
741X11X11
751X11211
761X11112
77211112215
781X211XX
79111111X
8011111X1
81222X1XX
822X112X1
83
84
85
86
Sheet1


Thank you in advance

Kishan
 
Re: Count the period once cycle is completed tricky one

Try this for basic result in column "K" :-
Code:
[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
 
Upvote 0

Excel Facts

Last used cell?
Press Ctrl+End to move to what Excel thinks is the last used cell.
Re: Count the period once cycle is completed tricky one

Try this for basic result in column "K" :-
Code:
[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
 
Last edited:
Upvote 0
Re: Count the period once cycle is completed tricky one

What about this more user friendly UDF:

Code:
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. :

[TABLE="width: 85%"]
<tbody>[TR]
[TD]Worksheet Formulas[TABLE="width: 100%"]
<thead>[TR="bgcolor: <a href="]
[TH="width: 10px"]Cell[/TH]
[TH="align: left"]Formula[/TH]
[/TR]
</thead><tbody>[TR]
[TH="width: 10px, bgcolor: <a href="]N6[/TH]
[TD="align: left"]=Cyclecount(C6:I32)[/TD]
[/TR]
[TR]
[TH="width: 10px, bgcolor: <a href="]N7[/TH]
[TD="align: left"]=Cyclecount(C33:I62)[/TD]
[/TR]
[TR]
[TH="width: 10px, bgcolor: <a href="]N8[/TH]
[TD="align: left"]=Cyclecount(C63:I82)[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[/TR]
</tbody>[/TABLE]
 
Last edited:
Upvote 0
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
 
Upvote 0
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:

Code:
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.
 
Last edited:
Upvote 0
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:

Code:
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 :)
 
Upvote 0
Re: Count the period once cycle is completed tricky one

Glad it works for you. :cool:

Consider this update that shows the totals in L:R

Code:
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
 
Last edited:
Upvote 0
Re: Count the period once cycle is completed tricky one

Glad it works for you. :cool:

Consider this update that shows the totals in L:R

Code:
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. :cool: Thank you very much

I appreciate a lot your kind help

Kind Regards,
Kishan
:)
 
Last edited:
Upvote 0
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
 
Last edited:
Upvote 0
Try adding the lines in red:

Rich (BB code):
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
 
Last edited:
Upvote 0

Forum statistics

Threads
1,223,964
Messages
6,175,659
Members
452,666
Latest member
AllexDee

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