# Creating full-spectrum color gradients in bar chart based on input value

#### Ushiwakka

##### New Member
I'm creating a resource for the stats behind the mechanics of a video game I'm designing and would like the value of each stat to scale from red (lowest) through yellow, to green, and finally cyan (highest). I'd post an image link but I'm not allowed to yet; the stat bars for the Pokemon on the Smogon site is very similar to what I'm going for.

Ideally the color and length of the bar would automate once a number is input. In Excel the fill effects only allow for two colors rather than a gradual spectrum; any help on how to implement this is much appreciated. (using version 2016)

### Excel Facts

Does the VLOOKUP table have to be sorted?
No! when you are using an exact match, the VLOOKUP table can be in any order. Best-selling items at the top is actually the best.

#### Worf

##### Well-known Member
Welcome

Something like this? Do you have the image icon shown below?

#### Worf

##### Well-known Member
Try this code:

VBA Code:
Dim p As Point, sc As Series, arr, i%, fr!
Set sc = ActiveChart.FullSeriesCollection(1)
arr = sc.Values
For i = LBound(arr) To UBound(arr)
Set p = ActiveChart.FullSeriesCollection(1).Points(i)
fr = arr(i) / WorksheetFunction.Max(arr)
Select Case True
Case fr < 0.33
p.Format.Fill.ForeColor.RGB = RGB(250, 10, 10)
Case fr > 0.33 And fr < 0.66
p.Format.Fill.GradientStops.Insert RGB(250, 250, 10), 0.33 / fr
Case fr > 0.66 And fr < 0.9
p.Format.Fill.GradientStops.Insert RGB(250, 250, 10), 0.33 / fr
p.Format.Fill.GradientStops.Insert RGB(10, 250, 10), 0.66 / fr
Case fr > 0.9
p.Format.Fill.ForeColor.RGB = RGB(10, 250, 250)
p.Format.Fill.GradientStops.Insert RGB(250, 10, 10), 0 / fr
p.Format.Fill.GradientStops.Insert RGB(250, 250, 10), 0.33 / fr
p.Format.Fill.GradientStops.Insert RGB(10, 250, 10), 0.66 / fr
p.Format.Fill.GradientStops.Insert RGB(10, 250, 250), 0.9 / fr
End Select
Next
End Sub

#### Ushiwakka

##### New Member
Try this code:

View attachment 29078

VBA Code:
Dim p As Point, sc As Series, arr, i%, fr!
Set sc = ActiveChart.FullSeriesCollection(1)
arr = sc.Values
For i = LBound(arr) To UBound(arr)
Set p = ActiveChart.FullSeriesCollection(1).Points(i)
fr = arr(i) / WorksheetFunction.Max(arr)
Select Case True
Case fr < 0.33
p.Format.Fill.ForeColor.RGB = RGB(250, 10, 10)
Case fr > 0.33 And fr < 0.66
p.Format.Fill.GradientStops.Insert RGB(250, 250, 10), 0.33 / fr
Case fr > 0.66 And fr < 0.9
p.Format.Fill.GradientStops.Insert RGB(250, 250, 10), 0.33 / fr
p.Format.Fill.GradientStops.Insert RGB(10, 250, 10), 0.66 / fr
Case fr > 0.9
p.Format.Fill.ForeColor.RGB = RGB(10, 250, 250)
p.Format.Fill.GradientStops.Insert RGB(250, 10, 10), 0 / fr
p.Format.Fill.GradientStops.Insert RGB(250, 250, 10), 0.33 / fr
p.Format.Fill.GradientStops.Insert RGB(10, 250, 10), 0.66 / fr
p.Format.Fill.GradientStops.Insert RGB(10, 250, 250), 0.9 / fr
End Select
Next
End Sub
Thank you, but is it possible to get solid colors as in the image I posted? Each bar wouldn't have it's own gradient, but the range would be on a gradient that narrows to a single color for a given value. Or is the image you posted not indicative of the final product?

#### Worf

##### Well-known Member
New version:

VBA Code:
Dim p As Point, sc As Series, arr, i%, fr!
arr = ActiveChart.FullSeriesCollection(1).Values
For i = LBound(arr) To UBound(arr)
Set p = ActiveChart.FullSeriesCollection(1).Points(i)
fr = arr(i) / WorksheetFunction.Max(arr)
Select Case True
Case fr < 0.33
p.Format.Fill.ForeColor.RGB = RGB(250, 10, 10)
Case fr > 0.33 And fr < 0.66
p.Format.Fill.ForeColor.RGB = RGB(250, 250, 10)
Case fr > 0.66 And fr < 0.9
p.Format.Fill.ForeColor.RGB = RGB(10, 250, 10)
Case fr > 0.9
p.Format.Fill.ForeColor.RGB = RGB(10, 250, 250)
End Select
Next
End Sub

Replies
5
Views
392
Replies
1
Views
543
Replies
9
Views
982
Replies
4
Views
12K

1,129,445
Messages
5,636,322
Members
416,912
Latest member
danluk12

### We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.

### Which adblocker are you using?

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

### Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

### Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back