Europa MacDonald
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:=xlPreviou s).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).lngColo r = -1 Then
DupeSets(lngFound).lngColo r = lngColors(lngNextColor)
If lngNextColor < UBound(lngColors) Then
lngNextColor = lngNextColor + 1
End If
End If
Range(DupeSets(lngFound).s trAddr).In terior.Col or = DupeSets(lngFound).lngColo r
Range(DupeSets(lngFound).s trAddr).Of fset(0, 1).Interior.Color = DupeSets(lngFound).lngColo r
Range(DupeSets(lngFound).s trAddr).Of fset(0, 2).Interior.Color = DupeSets(lngFound).lngColo r
Range(Cells(lngRow, lngCol), Cells(lngRow, lngCol + 2)).Interior.Color = DupeSets(lngFound).lngColo r
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
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).
lngLastColumn = Cells.Find("*", SearchOrder:=xlByColumns, LookIn:=xlValues, SearchDirection:=xlPreviou
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
lngFound = lngFind
Exit For
End If
Next
If lngFound > -1 Then
If DupeSets(lngFound).lngColo
DupeSets(lngFound).lngColo
If lngNextColor < UBound(lngColors) Then
lngNextColor = lngNextColor + 1
End If
End If
Range(DupeSets(lngFound).s
Range(DupeSets(lngFound).s
Range(DupeSets(lngFound).s
Range(Cells(lngRow, lngCol), Cells(lngRow, lngCol + 2)).Interior.Color = DupeSets(lngFound).lngColo
Else
DupeSets(UBound(DupeSets))
DupeSets(UBound(DupeSets))
DupeSets(UBound(DupeSets))
ReDim Preserve DupeSets(UBound(DupeSets) + 1)
End If
Next
End If
Next
End Sub
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?
»bp
Could it be adjusted to find those sets of three numbers which match 5 or more times
»bp
ASKER
apologies Bill, I am getting my data confused here.
yes just 5 matches
yes just 5 matches
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
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
»bp
ASKER
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
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
Tools - Macros - Triples
»bp
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
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
»bp
»bp