Active Member
May 19, 2020
Hello everyone.
I am new in doing macro and i am struggling a lot regarding a macro to changing the color of a shape (country) when the value in a cell changes
For exemple,
if the cell is 20, i want to have the country in Green
if the cell is 28, i want to have the country in Clear Green
...
Please see below the Macro Code which doesn't work. Moreover, when i run this macro, the "Model" window is coming and i don't know what to do with it. Please i would really appreciate your help 🙂
Private Sub Worksheet_Change(ByVal Target As Range)
For i = 1 To 150
If Sheet1.Cells(i + 1, 2) = "20" Then
Sheet1.Shapes.Range(Array(Sheet1.Cells(i + 1, 2))).Fill.ForeColor.RGB = RGB(112, 173, 71)
ElseIf Sheet2.Cells(i + 1, 2) = "28" Then
Sheet1.Shapes.Range(Array(Sheet1.Cells(i + 1, 2))).Fill.ForeColor.RGB = RGB(198, 224, 180)
ElseIf Sheet1.Cells(i + 1, 2) = "43" Then
Sheet1.Shapes.Range(Array(Sheet1.Cells(i + 1, 2))).Fill.ForeColor.RGB = RGB(255, 242, 204)
ElseIf Sheet1.Cells(i + 1, 2) = "60" Then
Sheet1.Shapes.Range(Array(Sheet1.Cells(i + 1, 2))).Fill.ForeColor.RGB = RGB(230, 230, 101)
ElseIf Sheet1.Cells(i + 1, 2) = "90" Then
Sheet1.Shapes.Range(Array(Sheet1.Cells(i + 1, 2))).Fill.ForeColor.RGB = RGB(255, 101, 101)
End If
Next i
End Sub
October 5, 2010
Hi Damien,
If you can attach your workbook I can write something specific for you but without it I can only give you something generic like this using SELECT CASE
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A1")) Is Nothing Then
Select Case Range("A1").Value
Case 20
ActiveSheet.Shapes.Range(Array("MyShape")).Fill.ForeColor.RGB = RGB(0, 255, 0)
Case 28
ActiveSheet.Shapes.Range(Array("MyShape")).Fill.ForeColor.RGB = RGB(0, 105, 0)
End Select
End If
End Sub
See attached.
Regards
Phil
Trusted Members
Moderators
November 1, 2018
Something like this would work if you had shapes for every country listed in column A (you don't currently):
Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Long
For i = 2 To 150
Dim lColour As Long
If Len(Sheet1.Cells(i, 1).Value) <> 0 Then
Select Case Sheet1.Cells(i, 2).Value2
Case 20
lColour = RGB(112, 173, 71)
Case 28
lColour = RGB(198, 224, 180)
Case 43
lColour = RGB(255, 242, 204)
Case 60
lColour = RGB(230, 230, 101)
Case 90
lColour = RGB(255, 101, 101)
Case Else
lColour = 11573124
End Select
Sheet1.Shapes(Sheet1.Cells(i, 1)).Fill.ForeColor.RGB = lColour
End If
Next i
End Sub
though I would suggest it would be easier to maintain if you used the table of values directly and read the corresponding colour either from the adjacent cell, or simply colour each value cell.
Active Member
May 19, 2020
Hi Velouria, Philip,
Thanks for your help, however, even after trying both of your code, i can't succeed. i don't understand what happened and my knowledge is not that good.
Thanks to Velouria, only country are colored but not all the ones mentioned on the column A. please, see attached the file, i would really appreciate if you could have a look.
Thanks again
October 5, 2010
Hi Damien,
When you are attaching files to the forum you are attaching XLSX files which cannot have VBA code in them so each time we have to add the VBA back in! Please save your files as XLSM.
You don't say why you aren't succeeding. What exactly is the problem? You need to be as descriptive as possible about the outcome you want and the error(s) you are having including any error messages. Otherwise we are forced to make assumptions and guesses to fill in the missing information.
What is not clear to me is why you initially had the code in an event. This is run every time a change is made to the sheet. Is that what you want? Or did you just want to run the code on demand?
As Velouria mentioned, your list of countries is not complete. So there are lots of countries in the map that are not coloured in after the code runs.
In the list that is provided there are countries that do not exist in the map. Each country is a shape in Excel terms so our code refers to the country by referring to the shape with that name from your list e.g. the shape with the name Allemagne.
There are lots of country names that do not have a shape with the matching name e.g. Montenegro. The name of Macedonia in the list and the shape do not match. The shapes for Lithuania and Latvia are just called Freeform 149 and Freeform 150.
I've added some error handling to the code so that each time it encounters a country name that does not have a shape with the same name, that country name turns red.
You'll need to either remove those countries from your list, add a shape with the matching name or modify the existing shape (if there is one) so the names match.
Regards
Phil
1 Guest(s)