Calculate recurring instances between cell count - using trigger

[sfarad]

Hi guys,

Probably my best shot here to finish successfully my graduation with a study I am doing that I am now TOTALLY STUCK. Please read slowly as I will do my best to explain my needs:

In the Excel attached there are 27008 rows of random numbers from 0-36 (column B).
Each range of numbers is categorized as following:
0 = Color 2 1-6 = Color 3 7-12 = Color 4 13-18 = Color 1 19-24 = Color 5 25-30 = Color 6 31-36 = Color 7

What I need, in the first place, is to count is the number of sequences that only 2 random numbers of the same color appear one after another. Per example: Rows 2-3 4-5 20-24 23-24 etc.....
This is the easy part.
The "trigger" to stop counting would be a sequence where 3 or more numbers of the same color appear one after another. Per example: Rows 134-136.

So in the case that we take a sequence from row 2 to row 136 - the formula would count exactly 17 times that a group of 2 numbers of the same color appeared one after another until a group of 3 numbers of the same color one after another showed up and than the count stops and restarts.

The ultimate question of the study would be: out of 27008 rows, the longest sequence that 2 numbers of the same color appeared one after another until a 3 numbers one after another showed up is............. X

How do I achieve this? Really I have consulted my professors, computer engineers and many others, with 0 SUCCESS.
Please help me. Since I am no Excel programmer feel free to edit my excel and send back.

Here is a dl link
https://www77.zippyshare.com/v/KeZPfvd2/file.html

@@@THANK YOU SO MUCH@@@

 

[sfarad]

so you want each pairs row recorded?

Hello again,
Using your code I was able to find out that the maximum amount of instances was 18 until a 3 color group came.
What I need is also to tell me,
*How many times just 1 occurrence of 2 consecutive colors came in a cycle.
* How many times 2 occurrences
*3 occurences

ETC...

I am unable to deduce that from your code, what should I change please?

 

[sfarad]

And also,
As soon as I change/add values to B column, the code doesn't work - very weird!
Take a look please - it count 3 as highest - that is not true.
https://ufile.io/382za

 

[nemmi69]

How about this? (Did not that the number that makes the set of 3 is counted as a pair, is that an issue)

Option Explicit
Public WbName As Workbook
Public WsName1 As Worksheet
Dim Cloop As Long
Dim LastRowNo As Long
Dim CurVal As Integer
Dim NextVal As Integer
Dim CurMatchCount As Integer
Dim StartCurMatchCount As Integer
Dim EndCurMatchCount As Integer
Dim CountPair As Integer
Dim PairFnd As Boolean
Dim PairArray(6) As Integer
Dim LbPrAry As Integer
Dim UbPrAry As Integer




Sub FindHighestRepeat()
Set WbName = ThisWorkbook
Windows(ThisWorkbook.Name).Activate
Set WsName1 = WbName.Sheets(1) '("DORTMUND")


CurVal = 0
NextVal = 0
CurMatchCount = 0
StartCurMatchCount = 0
EndCurMatchCount = 0
CountPair = 0
PairFnd = False
WsName1.Range("I2").Value = 0
WsName1.Range("K2").Value = ""


LastRowNo = WsName1.Range("C65536").End(xlUp).Row


For Cloop = 2 To LastRowNo
    If CurVal > 0 Then 'just started so no value
        NextVal = WsName1.Range("C" & Cloop).Value
        If CurVal = NextVal And PairFnd = False Then 'if the search value hasn't been matched yet
            CurMatchCount = CurMatchCount + 2
            StartCurMatchCount = Cloop - 1 'set to previous row
            EndCurMatchCount = Cloop 'set to current row
            PairArray(CurVal - 1) = PairArray(CurVal - 1) + 1 '-1 because arrays start at 0
            PairFnd = True
            CurVal = NextVal
        ElseIf CurVal = NextVal And PairFnd = True Then 'if the search value matches and has been matched before
            CurMatchCount = CurMatchCount + 1
            EndCurMatchCount = EndCurMatchCount + 1
            CurVal = NextVal
        End If
        If CurVal <> NextVal And PairFnd = True Then 'current value is no longer matched but has been previously
            If CurMatchCount = 2 Then 'pair found
                CurMatchCount = 0
                StartCurMatchCount = 0
                EndCurMatchCount = 0
                PairFnd = False
                CountPair = CountPair + 1
                CurVal = NextVal
            End If
            If CurMatchCount = 3 Then 'three found
                WsName1.Range("K2").Value = "Row " & StartCurMatchCount & " row " & EndCurMatchCount
                WsName1.Range("K3").Value = "Count of Pairs"
                WsName1.Range("K4").Value = CountPair
                Exit For
            End If
        Else
            CurVal = NextVal
        End If
    Else
        CurVal = WsName1.Range("C" & Cloop).Value
    End If
Next Cloop
'write all matched colours
For Cloop = 0 To 6
WsName1.Range("J" & 2 + Cloop).Value = PairArray(Cloop)
Next Cloop
End Sub

 

[sfarad]

Hello again buddy,
Tried your new code but it seems to be wrong, take a look at the results it gave me please. It doesn't show me the information I need.
It should reflect the information as:
-The number of times a pair showed up 1 time in a cycle
-The number of times a pair showed up 2 times in a cycle
-The number of times a pair showed up 3 times in a cycle
etc...
And ultimately it would be the highest number of times a pair showed up in a cycle. Your first code did indeed show the highest number of pairs. It was 18 in the first spreadsheet.
Please take a look/ -> https://ufile.io/bixz8

 

[nemmi69]

Added the labels for each of the colours (I & J) as well as corrected the count

Option Explicit
Public WbName As Workbook
Public WsName1 As Worksheet
Dim Cloop As Long
Dim LastRowNo As Long
Dim CurVal As Integer
Dim NextVal As Integer
Dim CurMatchCount As Integer
Dim StartCurMatchCount As Integer
Dim EndCurMatchCount As Integer
Dim CountPair As Integer
Dim PairFnd As Boolean
Dim PairArray() As Integer
Dim ArrayCount As Integer




Sub FindHighestRepeat()
Set WbName = ThisWorkbook
Windows(ThisWorkbook.Name).Activate
Set WsName1 = WbName.Sheets(1) '("DORTMUND")


ReDim PairArray(6)
CurVal = 0
NextVal = 0
CurMatchCount = 0
StartCurMatchCount = 0
EndCurMatchCount = 0
CountPair = 0
PairFnd = False
WsName1.Range("I2").Value = 0
WsName1.Range("K2").Value = ""


LastRowNo = WsName1.Range("C65536").End(xlUp).Row


For Cloop = 2 To LastRowNo
    If CurVal > 0 Then 'just started so no value
        NextVal = WsName1.Range("C" & Cloop).Value
        If CurVal = NextVal And PairFnd = False Then 'if the search value hasn't been matched yet
            CurMatchCount = CurMatchCount + 2
            StartCurMatchCount = Cloop - 1 'set to previous row
            EndCurMatchCount = Cloop 'set to current row
            PairArray(CurVal - 1) = PairArray(CurVal - 1) + 1 '-1 because arrays start at 0
            PairFnd = True
            CurVal = NextVal
        ElseIf CurVal = NextVal And PairFnd = True Then 'if the search value matches and has been matched before
            CurMatchCount = CurMatchCount + 1
            EndCurMatchCount = EndCurMatchCount + 1
            CurVal = NextVal
        End If
        If CurVal <> NextVal And PairFnd = True Then 'current value is no longer matched but has been previously
            If CurMatchCount = 2 Then 'pair found
                CurMatchCount = 0
                StartCurMatchCount = 0
                EndCurMatchCount = 0
                PairFnd = False
                CountPair = CountPair + 1
                CurVal = NextVal
            End If
            If CurMatchCount = 3 Then 'three found
                PairArray(CurVal - 1) = PairArray(CurVal - 1) - 1 ' remove counted pair as now a triple
                WsName1.Range("K2").Value = "Row " & StartCurMatchCount & " row " & EndCurMatchCount
                WsName1.Range("K3").Value = "Count of Pairs"
                WsName1.Range("K4").Value = CountPair
                Exit For
            End If
        Else
            CurVal = NextVal
        End If
    Else
        CurVal = WsName1.Range("C" & Cloop).Value
    End If
Next Cloop
'write all matched colours
WsName1.Range("I1").Value = "Colour"
WsName1.Range("J1").Value = "Count"
ArrayCount = 0
For Cloop = 0 To 6
WsName1.Range("I" & 2 + Cloop).Value = Cloop + 1
WsName1.Range("J" & 2 + Cloop).Value = PairArray(Cloop)
ArrayCount = ArrayCount + PairArray(Cloop)
Next Cloop
WsName1.Range("J9").Value = "Total"
WsName1.Range("J10").Value = ArrayCount
End Sub

 

[sfarad]

My friend - this is perfect. BUT!!!!!!!!!
I think now I understand what the problem is.
As soon as the first set of 3 appear it stops the count! That is why it didn't work in the first place. In the first spreadsheet, the set of 3 appears in row 134-136..In the second spreadsheet I sent you, the first set of 3 appear row 43-45.
BUT THEN IT STOPS COUNTING. There are 30 thousand lines.
The intention is once a set of 3 appears - it records the number of pair hits - shows it and then moves on to count the next number of pairs until the next set of 3 appears, so on until the end of the spreadsheet.
Is it possible to achieve this result??

 

[nemmi69]

My friend - this is perfect. BUT!!!!!!!!!
I think now I understand what the problem is.
As soon as the first set of 3 appear it stops the count! That is why it didn't work in the first place. In the first spreadsheet, the set of 3 appears in row 134-136..In the second spreadsheet I sent you, the first set of 3 appear row 43-45.
BUT THEN IT STOPS COUNTING. There are 30 thousand lines.
The intention is once a set of 3 appears - it records the number of pair hits - shows it and then moves on to count the next number of pairs until the next set of 3 appears, so on until the end of the spreadsheet.
Is it possible to achieve this result??

I wanted to check that the 1st cycle was OK. If you can wait till Monday I will get it to repeat until end

 

[sfarad]

First cycle is incredible and spot on.
I can wait until you say so, I am deeply grateful for the time and effort you have invested!!

P.S I tried copying this code to an other spreadsheet with 1 million rows and it didn't work. Is there any addition to the code I must add before copying it to an other xls? It is in the same format of columns except 1 million rows instead if 30k please let me know ))

 

[nemmi69]

Change "LastRowNo = WsName1.Range("C65536").End(xlUp).Row" to "LastRowNo = WsName1.Range("what ever the last row number is on a worksheet").End(xlUp).Row"

 

[sfarad]

Perfect. Will certainly do that.
Let me know when this can be completed I am very thankful buddy! Great showmanship