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

Hi Philip,

Thanks for your answer, really appreciate you take some time.
However, i still struggling Please see attached the file.

Thanks and regards 🙂

Hi Damien,

Can you please explain exactly what it is you are trying to do?  I'm not clear if you are trying to colour in all countries at once, or highlight certain ones depending on the value of a cell, or something else?

regards

Phil

Hi Philip,

Sorry, maybe i wasn't clear.

I would like to highlight certain countries depending on the value of a cell (column B). Please, kindly find attached, i have tried to make it clearer.

Thanks and regards

damien

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.

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

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

Hi Philip,

Thanks a lot, this is working now ! i appreciate your time and effort

Regards

You're welcome.