Link to home
Start Free TrialLog in
Avatar of Europa MacDonald
Europa MacDonaldFlag for United Kingdom of Great Britain and Northern Ireland

asked on

finding matching sets

I have this code which will find matching sets of three numbers (and colour them for ID) across a worksheet. (sample sheet attached 007-quad-ID-query-ee.xls )

Could it be adjusted to find those sets of three numbers which match 5 or more times ?
__________________________
Code :

Option Explicit

Private Type Sets
    strAddr As String
    strCells As String
    lngColor As Long
End Type

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 lngFound As Long
    Dim lngColors()
    Dim lngNextColor As Long

    lngColors = Array(13494512, 11599871, 13626575, 15723724, 15258845, 12178907, 8518399, 11461045, 14667418, 14136257, 10074816, 5369343, 9491089, 14071663, 12683685, 13233150, 11596768, 14541491, 15259071, 15654653, 10668797, 7791807, 12504966, 13674644, 13743867, 8759804, 6146693, 10728776, 12552565, 11963641, vbYellow)
    lngNextColor = 0

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

    For lngRow = 4 To lngLastRow
        If Cells(lngRow, 1) <> "" Then
            For lngCol = 8 To lngLastColumn Step 4
                strSet = Cells(lngRow, lngCol) & "," & Cells(lngRow, lngCol + 1) & "," & Cells(lngRow, lngCol + 2)
                lngFound = -1
                For lngFind = 0 To UBound(DupeSets)
                    If strSet = DupeSets(lngFind).strCells Then
                        lngFound = lngFind
                        Exit For
                    End If
                Next
                If lngFound > -1 Then
                    If DupeSets(lngFound).lngColor = -1 Then
                        DupeSets(lngFound).lngColor = lngColors(lngNextColor)
                        If lngNextColor < UBound(lngColors) Then
                            lngNextColor = lngNextColor + 1
                        End If
                    End If
                    Range(DupeSets(lngFound).strAddr).Interior.Color = DupeSets(lngFound).lngColor
                    Range(DupeSets(lngFound).strAddr).Offset(0, 1).Interior.Color = DupeSets(lngFound).lngColor
                    Range(DupeSets(lngFound).strAddr).Offset(0, 2).Interior.Color = DupeSets(lngFound).lngColor
                    Range(Cells(lngRow, lngCol), Cells(lngRow, lngCol + 2)).Interior.Color = DupeSets(lngFound).lngColor
                Else
                    DupeSets(UBound(DupeSets)).strCells = strSet
                    DupeSets(UBound(DupeSets)).strAddr = Cells(lngRow, lngCol).Address
                    DupeSets(UBound(DupeSets)).lngColor = -1
                    ReDim Preserve DupeSets(UBound(DupeSets) + 1)
                End If

            Next
        End If
    Next
End Sub
Avatar of Bill Prew
Bill Prew

Do you mean to only highlight with color when there are 5+ duplicates?


»bp
Avatar of Europa MacDonald

ASKER

To highlight only those which match 5 duplicates. Not 5+
So this should really be "exactly 5 matches"?  So only highlight when exactly 5 of the generated sets are the same?

Could it be adjusted to find those sets of three numbers which match 5 or more times


»bp
apologies Bill, I am getting my data confused here.

yes just 5 matches
ASKER CERTIFIED SOLUTION
Avatar of Bill Prew
Bill Prew

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
thankyou very much Bill.

I got this error on first trial


User generated image
Did you use the actual spreadsheet I posted above?  I just tested again here and it worked fine.  If needed please post the workbook here that is producing this error.


»bp
Apologies for taking so long to get back Bill

Ive attached the file, its the same file you sent me unchanged. Tried again but no bannana. I assume its correct to use Tools - Macro - Macros and select Identify Triplets ?

thanks
EE29039406.xls
Odd, I grabbed the last sheet you posted, and ran the "Triples" macro with no error.  When you get the error, if you click DEBUG, where in the code does it take you?

Tools - Macros - Triples


»bp
Ive posted a jpg

User generated image
When you get this error, can you include the left part of the Debug window showing what other files you have opened.  I suspect you have some other code that may be interfering with this code, since it works okay here.

Try to just open this sheet and no other sheets in Excel to test.


»bp
Can you follow up on this question please and let us know if it is all set (and close it) or provide additional info to keep working it.


»bp