Finding Repeat Range

joewagner501

New Member
Joined
Aug 20, 2015
Messages
7
I have wracked my brain and Google searches for several days trying to find an answer to my dilemma. Hopefully someone here can help with it.

I have a range of numbers within a large set of numbers that will repeat. For example, in the range below, the first nine numbers are a range that repeats afterward. This is a simple example because sometimes the repeat range may be 50 or more in length.

Is there a formula or macro that will scan a set of numbers to determine where the repeat range begins? In the example below, the ninth number is the last of the range that repeats and is therefore considered the beginning of the repeat range.

14.00
13.00
14.00
13.00
13.00
14.00
13.00
14.00
13.00
14.00
13.00
14.00
13.00
13.00
14.00
13.00
14.00
13.00
14.00
13.00
14.00
13.00
13.00
14.00
13.00
14.00
13.00

<colgroup><col width="64" style="width:48pt"></colgroup><tbody>
</tbody>


Any help would be greatly appreciated.
 
Assuming
Data in Sheet1 (headers in row 1; data beginning in row 2)
Repeated range in column C beginning in row 3
Code must return the longest length that is repeated

Maybe this...

Code:
Sub aTest()
    'Thread http://www.mrexcel.com/forum/excel-questions/877151-finding-repeat-range.html
    Dim firstRow As Long, numCol As Long
    Dim numRows As Long, i As Long, j As Long, Addr1 As String, Addr2 As String
    Dim factors As Object, lDiv As Long, bFound As Boolean
        
    Sheets("Sheet1").Activate
    'first row of repeated numbers
    firstRow = 3
    'column of repeated ramge
    numCol = 3
    
    'calculates the num of rows
    numRows = Range(Cells(firstRow, numCol), Cells(firstRow, numCol).End(xlDown)).Rows.Count
   
   'Creates a dictionaty to store the factors (dividers) of numRows
    Set factors = CreateObject("Scripting.Dictionary")
   
   'Calculates the factors(dividers) of numRows
    For i = 2 To numRows ^ (1 / 2)
        If numRows Mod i = 0 Then
            'Inserts dividers as keys of the dictionary
            factors(i) = Empty
            factors(numRows / i) = Empty
        End If
    Next i
    
    'checks repetition
    If factors.Count Then
        For j = 1 To factors.Count
            bFound = True
            
            'Picks the Largest j_th divider
            lDiv = Application.Large(factors.keys, j)
            
            For i = firstRow To numRows - lDiv Step lDiv
                Addr1 = Range(Cells(i, numCol), Cells(i + lDiv - 1, numCol)).Address
                Addr2 = Range(Cells(i + lDiv, numCol), Cells(i + 2 * lDiv - 1, numCol)).Address
                'Debug.Print "lDiv=" & lDiv & " Ad1= " & Addr1 & " Ad2= " & Addr2
                If lDiv <> Evaluate("SUMPRODUCT(--(" & Addr1 & "=" & Addr2 & "))") Then
                    bFound = False
                    Exit For
                End If
            Next i
            If bFound Then Exit For
        Next j
    End If
    
    If bFound Then
        MsgBox "Last row of the first repeated range= " & firstRow + lDiv - 1
    Else
        MsgBox "No repeated range was found"
    End If
End Sub

Hope this helps

M.
 
Upvote 0

Excel Facts

Highlight Duplicates
Home, Conditional Formatting, Highlight Cells, Duplicate records, OK to add pink formatting to any duplicates in selected range.
In other words, if the beginning (first cell) of the repeated range is fixed (always row 3), i believe that the solution will not be so complicated. But if the first cell of the repeated range is variable (any row) things get much more difficult ...

BTW i'm assuming the code must find the longest length that is repeated. Am i right?

M.


You are correct.
 
Upvote 0
Marcelo,

Thank you for the VB. An area I am very novice at. I tried the code on the file I am using as an example but it didn't find a repeat.
 
Upvote 0
I think this will do what you want.
It looks at the matrix myRange=TRANSPOSE(myRange) by going along the non-main diagonals and counting sequential TRUEs.

Code:
Sub test()
    Dim dataRange As Range, dataVals As Variant
    Dim Size As Long
    Dim i As Long, j As Long
    Dim currentRun As Long, maxRun As Long
    Dim EndOfRun As Long
    Dim DiagonalIndex As Long
    
    Set dataRange = Range(Cells(1, 1), Cells(Rows.Count, 1).End(xlUp))
    Size = dataRange.Rows.Count
    dataVals = dataRange.Value
    
    For DiagonalIndex = 2 To Size
        currentRun = 0
        i = 1: j = DiagonalIndex
        Do
            If dataVals(i, 1) = dataVals(j, 1) Then
                currentRun = currentRun + 1
                If maxRun < currentRun Then
                    maxRun = currentRun
                    EndOfRun = Application.Max(i, j)
                End If
            Else
                currentRun = 0
            End If
            i = i + 1: j = j + 1
        Loop While i <= Size And j <= Size
    Next DiagonalIndex
    
    MsgBox "a run of length " & maxRun & " starts at row " & (EndOfRun - 2 * maxRun + 1)
End Sub
 
Upvote 0
I downloaded your file and noticed some problems with the data

1. Range C66:C74 are NOT equal to other ranges - cells C70 and C71 are reversed.

2. There are problems with the values (rounding) , since some value are 13,00 and others 13,0000001 for example
The code was not founding a repeated range because of these two issues.

3. With the data sample provided in your file the longest repeated range is C3:C56 (54 rows), not C3:C11 (9 rows)

After the required adjustments in the data and also a minor adjustment in the code, everything worked fine. Observe the code is using Sheet Adjusted (you can change it easily)

Link to my file (see sheet Adjusted)
https://app.box.com/s/ug0cw780gfulyn5bna08alasiubswxdz

M.
 
Upvote 0
New version of the code

Code:
Sub aTest()
    'Thread http://www.mrexcel.com/forum/excel-questions/877151-finding-repeat-range.html
    Dim firstRow As Long, numCol As Long
    Dim numRows As Long, i As Long, j As Long, Addr1 As String, Addr2 As String
    Dim factors As Object, lDiv As Long, bFound As Boolean, v As Variant
        
    Sheets("Adjusted").Activate
    'first row of repeated numbers
    firstRow = 3
    'column of repeated ramge
    numCol = 3
    
    'calculates the num of rows
    numRows = Range(Cells(firstRow, numCol), Cells(firstRow, numCol).End(xlDown)).Rows.Count
   
   'Creates a dictionaty to store the factors (dividers) of numRows
    Set factors = CreateObject("Scripting.Dictionary")
   
   'Calculates the factors(dividers) of numRows
    For i = 2 To numRows ^ (1 / 2)
        If numRows Mod i = 0 Then
            'Inserts dividers as keys of the dictionary
            factors(i) = Empty
            factors(numRows / i) = Empty
        End If
    Next i
            
    'checks repetition
    If factors.Count Then
        For j = 1 To factors.Count
            bFound = True
            
            'Picks the Largest j_th divider
            lDiv = Application.Large(factors.keys, j)
                        
            Addr1 = Range(Cells(firstRow, numCol), Cells(firstRow + lDiv - 1, numCol)).Address
                        
            For i = firstRow To numRows - lDiv Step lDiv
                Addr2 = Range(Cells(i + lDiv, numCol), Cells(i + 2 * lDiv - 1, numCol)).Address
                'Debug.Print "lDiv=" & lDiv & " Ad1= " & Addr1 & " Ad2= " & Addr2
                
                If lDiv <> Evaluate("SUMPRODUCT(--(ROUND(" & Addr1 & ",2)=ROUND(" & Addr2 & ",2)))") Then
                    bFound = False
                    Exit For
                End If
            Next i
            If bFound Then Exit For
        Next j
    End If
    
    If bFound Then
        MsgBox "Last row of the first repeated range= " & firstRow + lDiv - 1
    Else
        MsgBox "No repeated range was found"
    End If
End Sub

M.
 
Upvote 0

Forum statistics

Threads
1,215,219
Messages
6,123,688
Members
449,117
Latest member
Aaagu

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