Change Colour

vmjan02

Well-known Member
Joined
Aug 15, 2012
Messages
1,134
Office Version
  1. 365
  2. 2021
  3. 2019
  4. 2016
  5. 2013
I have the code below and just need to work it in correct way

this table below has the colour code in RGB it should fill the colour with respect to RGB , if the cell value is above 70 then RGB colour fill should be (0,176,80) and so on.

any help

1​
109.43​
RGB0,176,80Green color> 70
2​
105.826​
RGB146,208,80light green>55 - <=70
3​
103.195​
RGB255,0,0Red<55
5​
83.479​
6​
105.624​
7​
47.382​
8​
104.02​
9​
111.292​
10​
61.826​
11​
97.132​
12​
109.231​
13​
66.869​
14​
175.715​




VBA Code:
Sub fillcolor()

For I = 1 To 15
a = Sheet1.Cells(I + 1, 2) / 71 * 255
c = Sheet1.Cells(I + 1, 2) / 70 * 255
b = Sheet1.Cells(I + 1, 2) / 55 * 255

Sheet1.Shapes.Range(Array("Freeform " & I + 1)).Fill.ForeColor.RGB = RGB(a, c, b)
Next I


End Sub
 

Excel Facts

Links? Where??
If Excel says you have links but you can't find them, go to Formulas, Name Manager. Look for old links to dead workbooks & delete.
With
VBA Code:
Shapes.Range[COLOR=rgb(226, 80, 65)](Array[/COLOR]("Freeform " & I + 1)[COLOR=rgb(235, 107, 86)])[/COLOR].Freeform " & I + 1)[COLOR=rgb(226, 80, 65)])[/COLOR]
it would suggest that it is from a recorded macro
IF that is the case??????
Try????
Sheet1.Shapes.Range("Freeform " & I + 1).Fill.ForeColor.RGB = RGB(a, c, b)
 
Upvote 0
Sorry my coloring of of specific text in the code has gone amis!!
The appearance of "ARRAY" and the extra ()() suggests its a recorded macro ???
But still try my my suggestion
 
Upvote 0
With
VBA Code:
Shapes.Range[COLOR=rgb(226, 80, 65)](Array[/COLOR]("Freeform " & I + 1)[COLOR=rgb(235, 107, 86)])[/COLOR].Freeform " & I + 1)[COLOR=rgb(226, 80, 65)])[/COLOR]
it would suggest that it is from a recorded macro
IF that is the case??????
Try????
Sheet1.Shapes.Range("Freeform " & I + 1).Fill.ForeColor.RGB = RGB(a, c, b)

It is giving me syntax error
VBA Code:
Shapes.Range[COLOR=rgb(226, 80, 65)](Array[/COLOR]("Freeform " & I + 1)[COLOR=rgb(235, 107, 86)])[/COLOR].Freeform " & I + 1)[COLOR=rgb(226, 80, 65)])[/COLOR]

and is not taking correct colors.
Sheet1.Shapes.Range("Freeform " & I + 1).Fill.ForeColor.RGB = RGB(a, c, b)

Just to know, its not a recorded macros.
 
Upvote 0
It is giving me syntax error
VBA Code:
Shapes.Range[COLOR=rgb(226, 80, 65)](Array[/COLOR]("Freeform " & I + 1)[COLOR=rgb(235, 107, 86)])[/COLOR].Freeform " & I + 1)[COLOR=rgb(226, 80, 65)])[/COLOR]

and is not taking correct colors.
Sheet1.Shapes.Range("Freeform " & I + 1).Fill.ForeColor.RGB = RGB(a, c, b)

Just to know, its not a recorded macros.
Sorry my mistake with the "Array" bit appearing due to being a recorded macro.
Realised later that it was intended because you where using;
VBA Code:
= RGB(a, c, b)

May be someone else has a suggestion?
 
Upvote 0
Sorry my coloring of of specific text in the code has gone amis!!
For that, use the 'RICH' code tags, not the 'VBA' tags.

@vmjan02
What do shapes have to do with it? From your initial table, it looks to me like you want to colour cells depending on the value in the cells.
Can you explain in more detail exactly what you have and what you are trying to do?
 
Upvote 0
@Peter_SSs
No I want to colour the "Freeform " shapes with respect respect to cell values.

eg:- if B1 value is >70 then the Freeform 1 should be colour as rgb(0,176,80) and if B1 vaulue is >55 and <=70 then Freeform 1 should be colour as rgb(146,208,80) and if B1 vaile is <=55 then Freeform 1 should be colour as rgb(255,0,0) and I have in total 14 Freeform.

I hope now I am clear.
 
Upvote 0
Thanks for the clarification. I have assumed
  1. that the values to be checked actually start in B2 not B1 (fits more with your code from post 1)
  2. that Red is actually for <=55 (your post 1 table of RGB values does not allow for exactly 55)
Given those assumptions, try this

VBA Code:
Sub fillcolor_v2()
  Dim i As Long
  Dim sRGB As String
  Dim vRGB As Variant
  
  For i = 1 To 15
    Select Case Sheet1.Cells(i + 1, 2).Value
      Case Is <= 55: sRGB = "255,0,0"
      Case Is <= 70: sRGB = "146,208,80"
      Case Else: sRGB = "0,176,80"
    End Select
    vRGB = Split(sRGB, ",")
    Sheet1.Shapes.Range(Array("Freeform " & i)).Fill.ForeColor.RGB = RGB(vRGB(0), vRGB(1), vRGB(2))
  Next i
End Sub
 
Upvote 0
Sub fillcolor_v2() Dim i As Long Dim sRGB As String Dim vRGB As Variant For i = 1 To 15 Select Case Sheet1.Cells(i + 1, 2).Value Case Is <= 55: sRGB = "255,0,0" Case Is <= 70: sRGB = "146,208,80" Case Else: sRGB = "0,176,80" End Select vRGB = Split(sRGB, ",") Sheet1.Shapes.Range(Array("Freeform " & i)).Fill.ForeColor.RGB = RGB(vRGB(0), vRGB(1), vRGB(2)) Next i End Sub
tried this

but this line is giving me error 1004

VBA Code:
Sheet1.Shapes.Range(Array("Freeform " & i)).Fill.ForeColor.RGB = RGB(vRGB(0), vRGB(1), vRGB(2))
 
Upvote 0

Forum statistics

Threads
1,224,817
Messages
6,181,149
Members
453,021
Latest member
Justyna P

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