Create a color gradient

B

Bearcat Brew

New Member
Joined
Dec 7, 2004
Messages
40
I have a list of RGB color coordinates - red value is in column B, green value in column C, and blue value in column D. Their are 240 sets of coordinates and from top to bottom, it should create a smooth color gradient from pale yellow (249, 248, 206) to dark brown (38, 23, 22). I ran this macro to get column A to represent the color from columns B, C, D:

Code: 
Sub Palette()

RowNum = 1
For RowNum = 1 To 240
    RedVal = Cells(RowNum, 2).Value
    GreenVal = Cells(RowNum, 3).Value
    BlueVal = Cells(RowNum, 4).Value
    Cells(RowNum, 1).Interior.Color = RGB(RedVal, GreenVal, BlueVal)
Next

End Sub

The result was not a smooth color palette, but a dozen or two cells the same color followed by another dozen or two of a darker color, repeating to row 240.

Questions:
-Why doesn't this work?
-I have now started doing this in MS Paint by hand. I go to the Edit Colors..., and create a custom color with one set of RGB values, then draw a vertical line about 20 pixels high by 1 pixel wide. I repeat for the next set of values and place the line next to the last one. This makes it look correct, but it is incredibly tedious. Is there a way to automate this from the table in Excel to draw lines in Paint?
 

Excel Facts

Copy PDF to Excel
Select data in PDF. Paste to Microsoft Word. Copy from Word and paste to Excel.
Sort by date Sort by votes
I downloaded it but there is a ton of stuff in there and most is beyond my comprehension level. I think I could figure it out if someone stepped me through it and got me in the right direction.
 
Upvote 0
An Example:

Code: 
Private Type mycolor
r As Byte
g As Byte
b As Byte
End Type
Sub Palette()
Dim i As Long, scolor As mycolor, ecolor As mycolor, tcolor As mycolor, n As Long
n = 500
scolor.r = 249
scolor.g = 248
scolor.b = 206
ecolor.r = 138
ecolor.g = 123
ecolor.b = 122
For i = 0 To n - 1
tcolor.r = Int(scolor.r - i * (scolor.r - ecolor.r) / (n - 1))
tcolor.g = Int(scolor.g - i * (scolor.g - ecolor.g) / (n - 1))
tcolor.b = Int(scolor.b - i * (scolor.b - ecolor.b) / (n - 1))
 ActiveSheet.Shapes.AddLine(0, [a1].Offset(i, 0).Top, [a1].Width, [a1].Offset(i, 0).Top).Select
Selection.ShapeRange.Line.Weight = [a1].Offset(i, 0).RowHeight
Selection.ShapeRange.Line.ForeColor.RGB = RGB(tcolor.r, tcolor.g, tcolor.b)
Next
End Sub
Best Regards
Northwolves
 
Upvote 0
Ah, much more clear. I really appreciate your help. I will give this a try to make modifications to what I have now since I will be able to do quick changes and see quick results.

I found a less tedious workaround in the mean time. I looked at the RGB values on a line chart and noticed distinct sections where the data were linear. Of the 240 values, it was linear from value 1 to 32, then a change of direction and linear again from value 33 to 80, etc. I then created a bar chart with the height of each bar equal to the number of values in that linear section. Next, I colored each bar individually with a color gradient by defining the two colors for the bar from bottom to top. From there, I copied the chart into MS Paint, cut out each bar, rotated 90 degrees, and laid them end to end. Still a manual operation and not exactly an elegant coded solution, but a lot better than drawing 240 lines manually.
 
Upvote 0
northwolves said:
An Example:

Code: 
Private Type mycolor
r As Byte
g As Byte
b As Byte
End Type
Sub Palette()
Dim i As Long, scolor As mycolor, ecolor As mycolor, tcolor As mycolor, n As Long
n = 500
scolor.r = 249
scolor.g = 248
scolor.b = 206
ecolor.r = 138
ecolor.g = 123
ecolor.b = 122
For i = 0 To n - 1
tcolor.r = Int(scolor.r - i * (scolor.r - ecolor.r) / (n - 1))
tcolor.g = Int(scolor.g - i * (scolor.g - ecolor.g) / (n - 1))
tcolor.b = Int(scolor.b - i * (scolor.b - ecolor.b) / (n - 1))
 ActiveSheet.Shapes.AddLine(0, [a1].Offset(i, 0).Top, [a1].Width, [a1].Offset(i, 0).Top).Select
Selection.ShapeRange.Line.Weight = [a1].Offset(i, 0).RowHeight
Selection.ShapeRange.Line.ForeColor.RGB = RGB(tcolor.r, tcolor.g, tcolor.b)
Next
End Sub
Best Regards
Northwolves
Click to expand...

Hi there, Northwolves. This would be perfect code for my purpose of creating a smooth rainbow from all red to all blue (hopefully moving through orange, yellow, green...), but it crashes if the scolor is 255,0,0 with an ecolor of 0,0,255. I guess I don't understand the math keeping the values within correct ranges. Can you help please?

Thanks!
 
Upvote 0
Oh, getting rid of the Bytes thing fixed the overflow:
Sub Palette()
Dim i As Long, sr As Long, sg As Long, sb As Long, er As Long, eg As Long, eb As Long, tr As Long, tg As Long, tb As Long, n As Long
i = Worksheets("plots").Cells(3, 29).Value
n = 500
sr = 255
sg = 0
sb = 0
er = 0
eg = 0
eb = 255
tr = Int(sr - i * (sr - er) / (n - 1))
tg = Int(sg - i * (sg - eg) / (n - 1))
tb = Int(sb - i * (sb - eb) / (n - 1))
ActiveSheet.Shapes.Range(Array("Rounded Rectangle 2")).Select
With Selection.ShapeRange.Fill
.ForeColor.RGB = RGB(tr, tg, tb)
End With
End Sub

But it only morphs from red to blue, without going through the other rainbow of colors. Some more complex math must be needed....?
 
Upvote 0
This works:
For i = 0 To 765
If i <= 255 Then
tr = Int(0 - i * (0 - 0) / 255)
tg = Int(0 - i * (0 - 255) / 255)
tb = Int(255 - i * (255 - 0) / 255)
ElseIf i > 255 And i < 510 Then
tr = Int(0 - (i - 255) * (0 - 255) / 255)
tg = Int(255 - (i - 255) * (255 - 255) / 255)
tb = Int(0 - (i - 255) * (0 - 0) / 255)
Else
tr = Int(255 - (i - 510) * (255 - 255) / 255)
tg = Int(255 - (i - 510) * (255 - 0) / 255)
tb = Int(0 - (i - 510) * (0 - 0) / 255)
End If

Range("P" & i + 28).Interior.Color = RGB(tr, tg, tb)

Next i
End Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

I
  • Question
Error in using VBA Macro with Apply Colors and Line Numbers
Replies
3
Views
184
intellitechdataservices
I
C
  • Question
VBA Sum and replace rather than Copy Destination
Replies
4
Views
316
Alex Blakenburg
A
G
  • Solved
Format & Protect range of cells using VBA
Replies
7
Views
543
Gajendran Yadhav
G
R
  • Question
Search a range for a specific color of rows, relocate those cells to another sheet, return previous sheet formatting to blank and sort secondary sheet
Replies
4
Views
122
Royalbloodi
R
C
  • Solved
Chase cell color for every other variable
2
Replies
13
Views
720
Joe4
Joe4

Forum statistics

Threads
1,218,338
Messages
6,141,859
Members
450,388
Latest member
Jordan4412

Share this page

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.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

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

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

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
Back
Top