Ranking matrix by value and corresponding name (over time)

[FloFlo]

I would like to rank a matrix by value (with corresponding name) per time period. Also, as the matrix will be a bit larger, I would like to indicate every person with a different color. That way one can easily see how each and everyone performed over time. So in the result, the background of Davis would be green for instance, Smith would be yellow and Jones red.

As an example:

	Monday	Tuesday	Wednesday
Smith	5	9	3
Jones	6	2	8
Davis	8	7	4

<tbody>
</tbody>

Desired result:

	Monday	Teusday	Wednesday
	Davis 8	Smith 9	Jones 8
	Jones 6	Davis 7	Davis 4
	Smith 5	Jones 2	Smith 3

<tbody>
</tbody>

So far the best way for me to do this was by hand as I did above, although I would like automate this process as results may differ on a daily basis.
Also, thusfar I am not able to assign names to numbers and colors in the same (or different) cell.

I hope this is clear. I would greatly appreciate any help.

Thanks,
Floris

 

[MickG]

What would you like to do Hard code the names and colours within the code, or have the names and colours in another sheet/range and get the code to pick the names /colours from there.???

 

[FloFlo]

Hi Mike,
The latter option would be perfect! When on another sheet, it is a lot easier to change names and matching colours.

 

[MickG]

Try this:-
Modify the line in Red in Main code and change the 2nd sub to the code below:-

Add you list of peoples Names in sheet3 column "A" starting row2, with your colour index numbers in column "B".
These numbers are 1 to a max of 50
Make sure all your names have a colour index.

 Set Rng = Sheets("Sheet2").Range("A1").Resize(c, UBound(Ray, 2) - 1)
 With Rng
    .Value = nRay
    .Borders.Weight = 2
    .Columns.AutoFit
End With
[B][COLOR=#FF0000]Newcols Rng[/COLOR][/B]
End Sub

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

Regrds Mick

 

[FloFlo]

Mick! Fantastic!
My final question: As your code still implies the regular colorindex (56 numbers), can I change this to rgb scale and thus select even more colour (of which many are also better looking).
Thanks a lot
Floris