Hi all,
I am working on a matrix consisting of multiple names matched to values. I would like to give everyone a specific RGB colour value (on different sheet). This way, one can easily recognize one another by colour (in addition to names and values in the cell).
At this moment I have a working code - with the regular 56-colour index - and I would like to change this to RBG scale.
Input:
[TABLE="width: 500"]
<tbody>[TR]
[TD]Name[/TD]
[TD]Colour[/TD]
[/TR]
[TR]
[TD]A[/TD]
[TD]255,0,0[/TD]
[/TR]
[TR]
[TD]B[/TD]
[TD]0,255,0[/TD]
[/TR]
[TR]
[TD]C[/TD]
[TD]0,0,255[/TD]
[/TR]
</tbody>[/TABLE]
Desired result(font is in colour instead of background as I was unable to process this in this message). NB. real matrix is larger.
[TABLE="width: 500"]
<tbody>[TR]
[TD]A[/TD]
[TD]C[/TD]
[TD]B[/TD]
[/TR]
[TR]
[TD]B[/TD]
[TD]A[/TD]
[TD]C[/TD]
[/TR]
[TR]
[TD]C[/TD]
[TD]B[/TD]
[TD]A[/TD]
[/TR]
</tbody>[/TABLE]
How can I change this code so that the interior colour will change on the basis of a given rgb value?
I hope I made myself clear enough, thanks in advance!
I am working on a matrix consisting of multiple names matched to values. I would like to give everyone a specific RGB colour value (on different sheet). This way, one can easily recognize one another by colour (in addition to names and values in the cell).
At this moment I have a working code - with the regular 56-colour index - and I would like to change this to RBG scale.
Input:
[TABLE="width: 500"]
<tbody>[TR]
[TD]Name[/TD]
[TD]Colour[/TD]
[/TR]
[TR]
[TD]A[/TD]
[TD]255,0,0[/TD]
[/TR]
[TR]
[TD]B[/TD]
[TD]0,255,0[/TD]
[/TR]
[TR]
[TD]C[/TD]
[TD]0,0,255[/TD]
[/TR]
</tbody>[/TABLE]
Desired result(font is in colour instead of background as I was unable to process this in this message). NB. real matrix is larger.
[TABLE="width: 500"]
<tbody>[TR]
[TD]A[/TD]
[TD]C[/TD]
[TD]B[/TD]
[/TR]
[TR]
[TD]B[/TD]
[TD]A[/TD]
[TD]C[/TD]
[/TR]
[TR]
[TD]C[/TD]
[TD]B[/TD]
[TD]A[/TD]
[/TR]
</tbody>[/TABLE]
How can I change this code so that the interior colour will change on the basis of a given rgb value?
Code:
Sub Newcols(nRng As Range)Dim rw As Long, Ac As Long, n As Long, fCol As Long
Dim Rng As Range, Dic As Object, Dn As Range
With Sheets("Sheet3")
Set Rng = .Range("A2", .Range("A" & Rows.Count).End(xlUp))
End With
Set Dic = CreateObject("scripting.dictionary")
For Each Dn In Rng: Dic(Dn.Value) = Dn.Offset(, 1).Value: Next Dn
For Ac = 1 To nRng.Columns.Count
For rw = 2 To nRng.Rows.Count Step 2
Select Case Dic(nRng(rw, Ac).Value)
Case 2, 6, 15, 19, 20, 22, 24, 27, 34, 35, 36, 37, 38, 39, 40, 43, 44, 45, 46, 51, 52: fCol = 1
Case Else: fCol = 2
End Select
nRng(rw, Ac).Interior.ColorIndex = Dic(nRng(rw, Ac).Value)
nRng(rw + 1, Ac).Interior.ColorIndex = Dic(nRng(rw, Ac).Value)
nRng(rw, Ac).Font.ColorIndex = fCol
nRng(rw + 1, Ac).Font.ColorIndex = fCol
Next rw
Next Ac
nRng.Font.Bold = True
End Sub
I hope I made myself clear enough, thanks in advance!