How do I find a repeating set of cells in Excel?

Question

I Have a 2100 Rows and 6 Columns Table

Throughout the table there are only 12 Possible values, say A,B,C,D,E,F,G,H,I,J,K,L The 12th value L is just a blank filler. It denotes blank cell.

Since there are only 11 possible values througout the table, patterns are observed.

First a Pattern Appears and it is later repeated somewhere in the table. There can be any number of Patterns, but i have a specific format for a pattern which is to found and reported that way.

Solutions in EXCEL-VBA, PHP-MYSQL or C are welcome.

I have attached an example of what Iam looking for. Suggestions are most welcome to refine the questions.

Information & Format : http://ge.tt/8QkQJet1/v/0 [ DOCX File 234 KB ]

Example in Excel Sheet : http://ge.tt/69htuNt1/v/0 [ XLSX File 16 KB ]

Please comment for more information or specific requirement.

Answer 1

Please try the code below, change the range to what you need it to be and the sheet number to the correct sheet number (I wouldn't put your full range in just yet because if you have 1000 pattern finds, you'll have to click OK on the message box 1000 times, just test with a partial range)

This will scan through the range, and find any pattern of two within a 10 row range, if you need it to find bigger patterns, youll need to add the same code again with an extra IF statement checking the next offset.

This will only find it if the same pattern exists and the same column structure is present, but its a start for you

Works fine on testing

Sub test10()

Dim rCell As Range
Dim rRng As Range

Set rRng = Sheets("Sheet1").Range("A1:I60") '-1 on column due to offset

'Scan through all cells in range and find pattern
For Each rCell In rRng.Cells
If rCell.Value = "" Then GoTo skip
         For i = 1 To 10
            If rCell.Value = rCell.Offset(i, 0).Value Then
                If rCell.Offset(0, 1).Value = rCell.Offset(i, 1) Then
                    MsgBox "Match Found at: " & rCell.Address & ":" & rCell.Offset(0, 1).Address & " and " & rCell.Offset(i, 0).Address & ":" & rCell.Offset(i, 1).Address
               End If
            End If
        Next i
skip:
Next rCell


End Sub

***UPDATE***

I have updated my code, the following now finds the pattern wherever it may appear in the next 10 rows:

Sub test10()

Dim rCell As Range
Dim rRng As Range
Dim r1 As Range
Dim r2 As Range

Set rRng = Sheets("Sheet1").Range("A1:I50") '-1 on column due to offset

i = 1 'row length
y = 0 'column length

'Scan through all cells in range and find pattern

For Each rCell In rRng.Cells
If rCell.Value = "" Then GoTo skip
i = 1
    Do Until i = 10
    y = 0
        Do Until y = 10
         xcell = rCell.Value & rCell.Offset(0, 1).Value
         Set r1 = Range(rCell, rCell.Offset(0, 1))
         r1.Select

         ycell = rCell.Offset(i, y).Value & rCell.Offset(i, y + 1).Value
         Set r2 = Range(rCell.Offset(i, y), rCell.Offset(i, y + 1))

            If ycell = xcell Then

                    Union(r1, r2).Font.Bold = True
                    Union(r1, r2).Font.Italic = True
                    Union(r1, r2).Font.Color = &HFF&
                    MsgBox "Match Found at: " & rCell.Address & ":" & rCell.Offset(0, 1).Address & " and " & rCell.Offset(i, y).Address & ":" & rCell.Offset(i, y + 1).Address
                    Union(r1, r2).Font.Bold = False
                    Union(r1, r2).Font.Italic = False
                    Union(r1, r2).Font.Color = &H0&
            End If
            y = y + 1
            Loop
            i = i + 1
        Loop
skip:
Next rCell


End Sub