Solved

# Identifying pairs of number groups with colours

Posted on 2013-02-04
223 Views
Last Modified: 2013-02-04
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
Question by:MichaelGlancy
• 3
4 Comments

LVL 46

Expert Comment

ID: 38852590
I'm here and I'll get back to you with the code.
0

LVL 46

Accepted Solution

Martin Liss earned 500 total points
ID: 38852684
``````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
``````
0

Author Closing Comment

ID: 38853039
Great, works fantastic

I now have more mechanical calculations to make, but if I could ask you more that would be great
0

LVL 46

Expert Comment

ID: 38853066
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

## Featured Post

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

### Suggested Solutions

The new Microsoft OS looks great, is easier than ever to upgrade to, it is even free.  So what's the catch?  If you don't change the privacy settings, Microsoft will, in accordance with the (EULA) you clicked okay to without reading, collect all the…
Technology opened people to different means of presenting information, but PowerPoint remains to be above competition. Know why PPT still works today.
This Micro Tutorial demonstrate the bugs in Microsoft Excel for Mac with Pivot Charts.
This Micro Tutorial will demonstrate how to use longer labels with horizontal bar charts instead of the vertical column chart.

#### 777 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.