Gradient Colour scale for a group of cells based on another cell showing "Y"

[Peter Davison]

Is it possible to use a Gradient Colour scale for a group of cells based on a different cell showing "Y"?

 

[jolivanes]

Re: "group of cells".
Each cell it's own color or a range with one color?
If it is a range, can you cover it with a TextBox of that size and fill it with the gradient color?

 

[jolivanes]

Found this through Mrs & Mr Google.

Sub SetGradient()
Dim myrange As Range
Set myrange = ThisWorkbook.Sheets("Sheet2").Range("B2")

    With myrange.Interior
        .Pattern = xlPatternLinearGradient
        .Gradient.Degree = 90
        .Gradient.ColorStops.Clear
    End With
    With myrange.Interior.Gradient.ColorStops.Add(0)
        .Color = 16777215
        .TintAndShade = 0
    End With
    With myrange.Interior.Gradient.ColorStops.Add(0.5)
        .Color = 7961087
        .TintAndShade = 0
    End With
    With myrange.Interior.Gradient.ColorStops.Add(1)
        .Color = 16777215
        .TintAndShade = 0
    End With
End Sub

Not that I know how it works but it might be a start for you.

 

[Peter Davison]

It is a gradient range from Red to Green based on the cell number contents (Lowers to highest number)
Thank you for the above I'll take a look a little later.

 

[Peter Davison]

Unfortunately the above code grades each cell the same.
I posted the below in a new enquiry, unfortunately I didn't realise I should have added it to this query. My apologies for that.
Any help with this would be appreciated.
Thanks to all.

--------
I have a range of rows/columns starting at I10 to AA10 and the number of rows can be different.
I have been looking for some code that can add this gradient conditional format but only if Cell D7 = "Y"

Each row needs its own gradient rather than all rows in the same gradient.

I found the code below from Fluff but I cant work out how to make it work for what I need?

If you can help it would be appreciated.

This is the code I found and have just changed the sheet name/cells

Sub GradientColour()
Dim Cl As Range, Rng As Range
Dim Mn As Long, Mx As Long, Av As Long
Dim LowClr As Variant, MidClr As Variant, HighClr As Variant

LowClr = Array(99, 190, 123)
MidClr = Array(255, 235, 132)
HighClr = Array(248, 107, 107)

Set Rng = Range("I10:AA10", Range("I" & Rows.Count).End(xlUp))

Mn = Application.Min(Rng)
Mx = Application.Max(Rng)
Av = Application.Percentile(Rng, 0.5)

Sheets("Report Writer").Select
Range("I10").Select

For Each Cl In Rng
If Cl <= Av Then
Cl.Offset(, 1).Interior.Color = GetColour(LowClr, MidClr, (Cl - Mn), (Av - Mn))
Else
Cl.Offset(, 1).Interior.Color = GetColour(HighClr, MidClr, (Cl - Mx), (Av - Mx))
End If
Next Cl
End Sub
Function GetColour(BaseClr As Variant, MidClr As Variant, Dif As Long, Avg As Long) As Long
Dim i As Long
Dim Clr As Double

For i = 0 To 2
Clr = (MidClr(i) - BaseClr(i)) / Avg
GetColour = GetColour + Int((Dif * Clr + BaseClr(i))) * 256 ^ i
Next i
End Function