# Identify similar groups of numbers

I have sets of six numbers.

I have selected all possible groups of three from each set of six numbers.

I have to cross examine between sets in order to identify where there are similarities.

This means if I find a set of three numers (eg 15,60,75) in one set of six numbers (eg 15,20,50,60,65,75), I have to inspect all other sets of six numbers to try and find the same.

I have to do this for all possible sets of three numbers from all sets of six.

on the worksheet that I have attached, I have separated out the "sets of three" for visual purposes, as I also have to be able to look through this list like this.
I would like to colour the cells of similar "sets of three numbers" the same colour. But each set pair found after that would require a different colour to be applied.

Would it be possible (without altering the cells of the original sets of six) to go through all of these sets of three numbers and identify other identical sets ?
select-groups-of-3.xls
###### Who is Participating?

x

Older than dirtCommented:
Sorry, I left out some code when I posted.

I've attached a workbook that contains the code. Look in Module1. IdentifyDuplicates is a macro to which I have assigned ctrl+z, so if you enter ctrl+z from the sheet the macro will execute. You could also go into the code environment select the macro and press F5.
select-groups-of-3.xls
0

Older than dirtCommented:
Looking at the data it seems that all sets of three have a duplicate since rows 3 and 4 are the same as 7 and 8. So if you run this code against that data all the sets of 3 will be highlighted, but maybe your real data is different.

``````Sub IdentifyDuplicates()

Dim lngLastRow As Long
Dim lngLastColumn As Long
Dim lngRow As Long
Dim lngCol As Long
Dim DupeSets() As Sets
Dim strSet As String
Dim lngFind As Long
Dim bFound As Boolean

ReDim DupeSets(0)
lngLastRow = Range("A65536").End(xlUp).Row
lngLastColumn = Cells.Find("*", SearchOrder:=xlByColumns, LookIn:=xlValues, SearchDirection:=xlPrevious).Column

For lngRow = 3 To lngLastRow
If Cells(lngRow, 1) <> "" Then
For lngCol = 9 To lngLastColumn Step 4
strSet = Cells(lngRow, lngCol) & Cells(lngRow, lngCol + 1) & Cells(lngRow, lngCol + 2)
bFound = False

For lngFind = 0 To UBound(DupeSets)
If strSet = DupeSets(lngFind).strCells Then
bFound = True
Exit For
End If
Next
If bFound Then
Range(Cells(lngRow, lngCol), Cells(lngRow, lngCol + 2)).Interior.Color = vbYellow
Else
DupeSets(UBound(DupeSets)).strCells = strSet
ReDim Preserve DupeSets(UBound(DupeSets) + 1)
End If

Next
End If
Next
End Sub
``````
0

Chief slayer of dragonsAuthor Commented:
thankyou I will try that. the data I gave you was a sample, purposely duplicated for demonstration. thanks again, checking now.
0

Chief slayer of dragonsAuthor Commented:
I get Error

cant execute code in break mode

Dim DupeSets() As Sets is highlighted

can you help as I am new user thankyou
0

Chief slayer of dragonsAuthor Commented:
and

user defined type not defined
0

Chief slayer of dragonsAuthor Commented:
does the job perfectly
0

Older than dirtCommented:
Thanks and I'm glad I was able to help.

Your accepting my answer as the solution put me over the 1,000,000 point mark! Thank you.

Marty - MVP 2009 to 2012
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.