Need to colour in shapes according to a value

[hawkinsr86]

Hi guys,

I have the a bunch of shapes I need fill with the colour green but I want the shade of green to be darker if the number is higher. Below is my data set. So for example I want Russia to be the greenest (because it is largest) and Luxembourg to be the least green etc...

Autoshape Name	Country	Population
S_ALB	Albania	3,639,453
S_AUT	Austria	8,210,281
S_BEL	Belgium	10,414,336
S_BGR	Bulgaria	7,204,687
S_BIH	Bosnia and Herzegovina	4,613,414
S_BLR	Belarus	9,648,533
S_CHE	Switzerland	7,604,467
S_CZE	Czech Republic	10,211,904
S_DEU	Germany	82,329,758
S_DNK	Denmark	5,500,510
S_ESP	Spain	40,525,002
S_EST	Estonia	1,299,371
S_FIN	Finland	5,250,275
S_FRA	France	64,057,792
S_GBR	United Kingdom	61,113,205
S_GRC	Greece	10,737,428
S_HRV	Croatia	4,489,409
S_HUN	Hungary	9,905,596
S_IRL	Ireland	4,203,200
S_ITA	Italy	58,126,212
S_LTU	Lithuania	3,555,179
S_LUX	Luxembourg	491,775
S_LVA	Latvia	2,231,503
S_MDA	Moldova	4,320,748
S_MKD	Macedonia	2,066,718
S_NLD	Netherlands	16,715,999
S_NOR	Norway	4,660,539
S_POL	Poland	38,482,919
S_PRT	Portugal	10,707,924
S_ROM	Romania	22,215,421
S_RUS	Russia	140,041,247
S_SR	Serbia	7,379,339
S_SVK	Slovakia	5,463,046
S_SVN	Slovenia	2,005,692
S_SWE	Sweden	9,059,651
S_UKR	Ukraine	45,700,395

<colgroup><col span="3"></colgroup><tbody>
</tbody>

Could someone please help me with the code as I dont know where to start.

Thanks
Ryan

 

[Damon Ostrander]

Hi Ryan,

Here's a simple user-defined function (UDF) you can use to do this:

Function ColorByArea(ShapeName As String, Pop As Double) As Boolean
   'Fill a shape named ShapeName with color green according to the population.
   'Largest population (Russia) -> dark green   (140,041,247)
   'Smallest population (Luxembourg) -> very light green  (491,775)
   Dim Pfac    As Single   'area factor
   Dim RB      As Integer  'red & blue color values
   Dim G       As Integer  'green color value
   On Error GoTo NotFound
   Pfac = Sqr(Pop / 14041247#)
   RB = (1 - Pfac) * 255
   G = 255 - Pfac * 130
   With ActiveSheet.Shapes(ShapeName)
      .Fill.ForeColor.RGB = RGB(RB, G, RB)
   End With
   ColorByArea = True
   Exit Function
NotFound:
   ColorByArea = False
End Function

I did this as a function rather than a macro so that you could call it directly from your worksheet. You can use it like this. I'll assume your autoshape name, country, and population values are in columns A:C. In column D (in this example D2) of the corresponding rows place the formula

=ColorByArea(A2,C2)

where A2 is the shape name and C2 is the population value. This should color the shape green with lightness according to the corresponding population value.

Of course, this function can be called from a Sub procedure within VBA, but I assumed that calling it from a cell would be more convenient.

To install this function in your workbook go to the Visual Basic Editor (keyboard Alt-TMV, insert a new macro module (Alt-IM), and paste my code into the Code pane. It will be instantly available to use.

 

[Damon Ostrander]

Hi again Ryan,

I forgot to mention that the function returns TRUE if the named shape is found on the active worksheet, otherwise it returns FALSE.

Damon

 

[MARK858]

Cross-posted

Need to change the colour of a shape according to its value

 

[hawkinsr86]

Hi Damon,

I did what you said but all the formulas are returning false for some reason. Any idea why?

Many Thanks

 

[hawkinsr86]

Sorry, I had the shapes on a different sheet. I have now fixed it.

Many Thanks!