Conditional colorscale - programmatically

Question

I am struggling to recreate logic behind Excel's three-colors scale for conditional formatting. This is the second option displayed when you choose Home-->Conditional Formatting -->Color Scale (red-yellow-green). I have started with this subroutine:

Sub Tricolore(Rng As Range)
Dim cl As Range
Dim dMax As Double
Dim dMin As Double
Dim dMed As Double
Dim dRed As Double
Dim dGreen As Double

dMax = WorksheetFunction.Max(Rng)
dMin = WorksheetFunction.Min(Rng)
dMed = WorksheetFunction.Median(Rng)

For Each cl In Rng

    'Here calculation begins
    If cl.Value <= dMed Then
        dGreen = 1
        dRed = (cl.Value - dMin) / (dMed - dMin)
    Else
        dRed = 1
        dGreen = (dMax - cl.Value) / (dMax - dMed)
    End If
    'and here it ends

    cl.Interior.Color = RGB(dRed * 255, 180 * dGreen, 110)
Next cl
End Sub

There are two problems here. The first and last color don't match the one used by MS Excel and I don't know how to find exact RGB parameters for color scale. There are solutions here and there for obtaining background color set up by CF, but they seem not to work for colorscales. The second problem is that the colors change too rapidly for values close to max and min and to slowly near the median of the range. So, I have tried to use a little of trigonometry and amended code between comments:

If cl.Value <= dMed Then
    dGreen = 1
    dRed = Sin((cl.Value - dMin) / (dMed - dMin) * Pi / 2)
Else
    dRed = 1
    dGreen = Sin((dMax - cl.Value) / (dMax - dMed) * Pi / 2)
End If

Below you can see results. Sinusoidal scale seems to follow Excel CF pattern, I think I am close here. But the border colors still not fit. I wonder, if anybody has better solution.

Did you see this link https://stackoverflow.com/questions/7408899/how-do-i-find-the-fill-colour-value-of-a-conditionally-formatted-cell-in-excel-2 and the associated solution using Word? — QHarr, Jan 05 '18 at 09:25

Conditional colorscale - programmatically

0 Answers0