Most Consecutive appearances in a range

[ollyhughes1982]

Hi,

I have the below worksheet (see first image), which lists all of my completed parkruns.

What I want to identify from this range (C4:C2003) is which event that I have done the most times consecutively (rather than the most times in total). I have manually calculated the correct figures (highlighted in yellow) for illustration of what I’m trying to achieve. As well as identifying which event it is, I’d also like to show the earliest and latest date for which this consecutive range took place.

On top of those three calculations, I’d also like to populate the second worksheet (see second image, below) with the actual list of the consecutive events, along with their number in the run and the dates. I’m guessing some sort of FILTER function might be needed for this. I've again highlighted in yellow, the manual results I am trying to automate.

I'd like to avoid adding any helper columns to these worksheets, if at all possible.

I have added a link to the (small) file, here: https://1drv.ms/x/c/f08b781118912fd2/Ee0-4PthSBBOtjXBxvogX0MBjJ76ECnenE_AJLdZyK_Wmg?e=51q17t

Thanks in advance!

Olly.

 

[Cubist]

This answers half of what you're looking - the most consecutive event.

Book1
	A	B	C	D	E	F	G	H	I
3	Run #	Event (Venue) Run #	Event (Venue)	Country	Date Completed	Finishing Position #
4	1	3	Newport parkrun	United Kingdom	9/4/11	54		Newport parkrun	78
5	2	4	Newport parkrun	United Kingdom	16/04/2011	45
6	3	5	Newport parkrun	United Kingdom	23/04/2011	57
7	4	6	Newport parkrun	United Kingdom	30/04/2011	40
Sheet2

Cell Formulas
Range	Formula
H4:I4	H4	=LET(s,SCAN(0,C4:C407=C5:C408,LAMBDA(a,b,IF(b,a+1,1))),m,MAX(s),HSTACK(XLOOKUP(m,s,C4:C407),m))
Dynamic array formulas.

 

[ollyhughes1982]

This answers half of what you're looking - the most consecutive event.

Book1
	A	B	C	D	E	F	G	H	I
3	Run #	Event (Venue) Run #	Event (Venue)	Country	Date Completed	Finishing Position #
4	1	3	Newport parkrun	United Kingdom	9/4/11	54		Newport parkrun	78
5	2	4	Newport parkrun	United Kingdom	16/04/2011	45
6	3	5	Newport parkrun	United Kingdom	23/04/2011	57
7	4	6	Newport parkrun	United Kingdom	30/04/2011	40
Sheet2

Cell Formulas
Range	Formula
H4:I4	H4	=LET(s,SCAN(0,C4:C407=C5:C408,LAMBDA(a,b,IF(b,a+1,1))),m,MAX(s),HSTACK(XLOOKUP(m,s,C4:C407),m))
Dynamic array formulas.

Hi. Thanks for looking at this, but that's giving 78, and it should be 81 times in a row.

Would adding some sort of helper column make it easier? It'd be ok to do that if it will solve it. This is just an extract from a sheet with many more columns within it, calculating verious things. I cut it down to just these columns for simplicity when illustrating on here.

 

[ollyhughes1982]

I have now come up with a helper column that counts correctly, which might help. This also allows me to calculate the completed date and the name of the event. I've highlighted these solutions (in blue).

I used the following formulas:

G4:

=IF(C5="","",1)

or you could just manually enter '1'

G5:

=IF(C5="","",IF(C4=C5,G4+1,1))

and fill-down to G2003

I4:

=XLOOKUP(MAX(G4:G2003),G4:G2003,C4:C2003)

K4: Uknown

M4:

=XLOOKUP(MAX(G4:G2003),G4:G2003,E4:E2003)

However, I cannot find the start date for the consecutive run, as there are obviously multiple minimum entries of '1'. I need some way of identifying the most recent '1' entry prior to the max value, i.e. the start of that sequence.

I still don't know how I can spill the results into the second worksheet.

 

[mumps]

Try:

Sub ConsecutiveRuns()
    Application.ScreenUpdating = False
    Dim v As Variant, i As Long, fnd As Range, fRow As Long, lRow As Long, desWS As Worksheet, srcWS As Worksheet
    Set srcWS = Sheets("All Completed Runs")
    Set desWS = Sheets("Consecutive")
    v = srcWS.Range("C4", srcWS.Range("C" & Rows.Count).End(xlUp)).Value
    For i = UBound(v) To LBound(v) Step -1
        If i > 1 Then
            If v(i, 1) <> v(i - 1, 1) Then
                Rows(i + 3).EntireRow.Insert
            End If
        End If
    Next i
    With srcWS.Range("A4", srcWS.Range("A" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeConstants)
        For i = 1 To .Areas.Count
            fRow = .Areas(i).Cells(1).Row
            lRow = .Areas(i).Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
            srcWS.Cells(srcWS.Rows.Count, 14).End(xlUp).Offset(1) = .Areas.Item(i).Cells.Count
            With srcWS
                .Cells(Rows.Count, 15).End(xlUp).Offset(1) = .Range("C" & i + 3)
                .Cells(Rows.Count, 16).End(xlUp).Offset(1) = fRow
                .Cells(Rows.Count, 17).End(xlUp).Offset(1) = lRow
                .Cells(Rows.Count, 18).End(xlUp).Offset(1) = .Range("E" & fRow)
                .Cells(Rows.Count, 19).End(xlUp).Offset(1) = .Range("E" & lRow)
            End With
        Next i
        With srcWS
            Set fnd = .Range("N:N").Find(WorksheetFunction.Max(.Range("N:N")))
            .Range("H4") = fnd.Offset(, 1)
            .Range("J4") = fnd.Offset(, 4)
            .Range("L4") = fnd.Offset(, 5)
            Intersect(.Rows(fnd.Offset(, 2) & ":" & fnd.Offset(, 3)), .Range("A:A,C:C,E:E")).Copy desWS.Range("A4")
            .Range("A:A").SpecialCells(xlBlanks).EntireRow.Delete
            .Range("N2", .Range("O" & .Rows.Count).End(xlUp)).Resize(, 6).ClearContents
        End With
    End With
    Application.ScreenUpdating = True
End Sub

 

[Cubist]

Hi. Thanks for looking at this, but that's giving 78, and it should be 81 times in a row.

I counted 79. You're missing runs #5 and #6 in your data. My formula needs to add 1 to the answer.

 

[ollyhughes1982]

Try:

Sub ConsecutiveRuns()
    Application.ScreenUpdating = False
    Dim v As Variant, i As Long, fnd As Range, fRow As Long, lRow As Long, desWS As Worksheet, srcWS As Worksheet
    Set srcWS = Sheets("All Completed Runs")
    Set desWS = Sheets("Consecutive")
    v = srcWS.Range("C4", srcWS.Range("C" & Rows.Count).End(xlUp)).Value
    For i = UBound(v) To LBound(v) Step -1
        If i > 1 Then
            If v(i, 1) <> v(i - 1, 1) Then
                Rows(i + 3).EntireRow.Insert
            End If
        End If
    Next i
    With srcWS.Range("A4", srcWS.Range("A" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeConstants)
        For i = 1 To .Areas.Count
            fRow = .Areas(i).Cells(1).Row
            lRow = .Areas(i).Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
            srcWS.Cells(srcWS.Rows.Count, 14).End(xlUp).Offset(1) = .Areas.Item(i).Cells.Count
            With srcWS
                .Cells(Rows.Count, 15).End(xlUp).Offset(1) = .Range("C" & i + 3)
                .Cells(Rows.Count, 16).End(xlUp).Offset(1) = fRow
                .Cells(Rows.Count, 17).End(xlUp).Offset(1) = lRow
                .Cells(Rows.Count, 18).End(xlUp).Offset(1) = .Range("E" & fRow)
                .Cells(Rows.Count, 19).End(xlUp).Offset(1) = .Range("E" & lRow)
            End With
        Next i
        With srcWS
            Set fnd = .Range("N:N").Find(WorksheetFunction.Max(.Range("N:N")))
            .Range("H4") = fnd.Offset(, 1)
            .Range("J4") = fnd.Offset(, 4)
            .Range("L4") = fnd.Offset(, 5)
            Intersect(.Rows(fnd.Offset(, 2) & ":" & fnd.Offset(, 3)), .Range("A:A,C:C,E:E")).Copy desWS.Range("A4")
            .Range("A:A").SpecialCells(xlBlanks).EntireRow.Delete
            .Range("N2", .Range("O" & .Rows.Count).End(xlUp)).Resize(, 6).ClearContents
        End With
    End With
    Application.ScreenUpdating = True
End Sub

Thanks, but I don’t want to use VBA. I am on a Mac and also my spreadsheet is already very large (300mb? and laggy (lags with the wheel of death for around 10 minutes at a time. Thanks though

 

[ollyhughes1982]

I counted 79. You're missing runs #5 and #6 in your data. My formula needs to add 1 to the answer.

No, it's definitely 81. You can see this in row 84. Runs 5 and 6 are there, on rows 8 and 9.

 

[Fluff]

How about

=LET(f,FILTER(C4:E2003,C4:C2003<>""),v,TAKE(f,,1),s,SCAN(0,DROP(v,-1)=DROP(v,1),LAMBDA(a,b,IF(b,a+1,1))),r,XMATCH(MAX(s),s)+1,HSTACK(INDEX(f,r-MAX(s)+1,{1,3}),INDEX(f,r,3)))

 

[ollyhughes1982]

How about

=LET(f,FILTER(C4:E2003,C4:C2003<>""),v,TAKE(f,,1),s,SCAN(0,DROP(v,-1)=DROP(v,1),LAMBDA(a,b,IF(b,a+1,1))),r,XMATCH(MAX(s),s)+1,HSTACK(INDEX(f,r-MAX(s)+1,{1,3}),INDEX(f,r,3)))

Thanks. That almost works, but the min date is one entry too high, it should start at 09/04/2011.