• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 238
  • Last Modified:

Identifying pairs of number groups with colours

MartinLiss very kindly gave me this code to help me with my project. (i dont know if I can contact that person directly on here for more help)

The code identifies similar pairs of 'combinations of three numbers' and highlights them in yellow.

This might be asking a lot, but is it possible to have the code do the same function, but highlight each new found pair of similar combinations in a different colour ?
3group.xls
0
Europa MacDonald
Asked:
Europa MacDonald
  • 3
1 Solution
 
Martin LissOlder than dirtCommented:
I'm here and I'll get back to you with the code.
0
 
Martin LissOlder than dirtCommented:
Option Explicit
Private Type Sets
    strAddr As String
    strCells As String
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 bFound As Boolean
Dim lngColor As Long
Dim R As Integer
Dim G As Integer
Dim B As Integer

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

Randomize

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
                GetNextColor R, G, B
                Range(DupeSets(lngFind).strAddr).Interior.Color = RGB(R, G, B)
                Range(DupeSets(lngFind).strAddr).Offset(0, 1).Interior.Color = RGB(R, G, B)
                Range(DupeSets(lngFind).strAddr).Offset(0, 2).Interior.Color = RGB(R, G, B)
                Range(Cells(lngRow, lngCol), Cells(lngRow, lngCol + 2)).Interior.Color = RGB(R, G, B)
            Else
                DupeSets(UBound(DupeSets)).strCells = strSet
                DupeSets(UBound(DupeSets)).strAddr = Cells(lngRow, lngCol).Address
                ReDim Preserve DupeSets(UBound(DupeSets) + 1)
            End If

        Next
    End If
Next
End Sub
Sub GetNextColor(R As Integer, G As Integer, B As Integer)
    
    R = Int((256) * Rnd)
    G = Int((256) * Rnd)
    B = Int((256) * Rnd)
    
End Sub

Open in new window

0
 
Europa MacDonaldChief slayer of dragonsAuthor Commented:
Great, works fantastic

I now have more mechanical calculations to make, but if I could ask you more that would be great
0
 
Martin LissOlder than dirtCommented:
Ask away. Post the link to the new question here, although I'll probably see it.

In any case you're welcome and I'm glad I was able to help.

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.

Join & Write a Comment

Featured Post

Free Tool: ZipGrep

ZipGrep is a utility that can list and search zip (.war, .ear, .jar, etc) archives for text patterns, without the need to extract the archive's contents.

One of a set of tools we're offering as a way to say thank you for being a part of the community.

  • 3
Tackle projects and never again get stuck behind a technical roadblock.
Join Now