• Skip to main content
  • Skip to header right navigation
  • Skip to site footer

My Online Training Hub

Learn Dashboards, Excel, Power BI, Power Query, Power Pivot

  • Courses
  • Pricing
    • Free Courses
    • Power BI Course
    • Excel Power Query Course
    • Power Pivot and DAX Course
    • Excel Dashboard Course
    • Excel PivotTable Course – Quick Start
    • Advanced Excel Formulas Course
    • Excel Expert Advanced Excel Training
    • Excel Tables Course
    • Excel, Word, Outlook
    • Financial Modelling Course
    • Excel PivotTable Course
    • Excel for Customer Service Professionals
    • Excel for Operations Management Course
    • Excel for Decision Making Under Uncertainty Course
    • Excel for Finance Course
    • Excel Analysis ToolPak Course
    • Multi-User Pricing
  • Resources
    • Free Downloads
    • Excel Functions Explained
    • Excel Formulas
    • Excel Add-ins
    • IF Function
      • Excel IF Statement Explained
      • Excel IF AND OR Functions
      • IF Formula Builder
    • Time & Dates in Excel
      • Excel Date & Time
      • Calculating Time in Excel
      • Excel Time Calculation Tricks
      • Excel Date and Time Formatting
    • Excel Keyboard Shortcuts
    • Excel Custom Number Format Guide
    • Pivot Tables Guide
    • VLOOKUP Guide
    • ALT Codes
    • Excel VBA & Macros
    • Excel User Forms
    • VBA String Functions
  • Members
    • Login
  • Blog
  • Excel Webinars
  • Excel Forum
    • Register as Forum Member

VBA : The color of the shape (country) doesn't change accordingly to the value in a cell|VBA & Macros|Excel Forum|My Online Training Hub

You are here: Home / VBA : The color of the shape (country) doesn't change accordingly to the value in a cell|VBA & Macros|Excel Forum|My Online Training Hub
Avatar
sp_LogInOut Log In sp_Registration Register
sp_Search Search
Advanced Search|Last Search Results
Search
Forum Scope




Match



Forum Options



Minimum search word length is 3 characters - maximum search word length is 84 characters
sp_Search Search
sp_RankInfo
Lost password?
sp_CrumbsHome HomeExcel ForumVBA & MacrosVBA : The color of the shape (count…
sp_PrintTopic sp_TopicIcon
VBA : The color of the shape (country) doesn't change accordingly to the value in a cell
Avatar
damien lemaire

Active Member
Members
Level 0
Forum Posts: 5
Member Since:
May 19, 2020
sp_UserOfflineSmall Offline
1
May 19, 2020 - 9:58 pm
sp_Permalink sp_Print

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

Avatar
Philip Treacy
Admin
Level 10
Forum Posts: 1529
Member Since:
October 5, 2010
sp_UserOfflineSmall Offline
2
May 19, 2020 - 10:40 pm
sp_Permalink sp_Print sp_EditHistory

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

Avatar
damien lemaire

Active Member
Members
Level 0
Forum Posts: 5
Member Since:
May 19, 2020
sp_UserOfflineSmall Offline
3
May 20, 2020 - 1:01 am
sp_Permalink sp_Print

Hi Philip,

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

Thanks and regards 🙂

Avatar
Philip Treacy
Admin
Level 10
Forum Posts: 1529
Member Since:
October 5, 2010
sp_UserOfflineSmall Offline
4
May 20, 2020 - 9:00 am
sp_Permalink sp_Print

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

Avatar
damien lemaire

Active Member
Members
Level 0
Forum Posts: 5
Member Since:
May 19, 2020
sp_UserOfflineSmall Offline
5
May 20, 2020 - 4:50 pm
sp_Permalink sp_Print

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

Avatar
Velouria
London or thereabouts
Moderator
Members


Trusted Members

Moderators
Level 4
Forum Posts: 648
Member Since:
November 1, 2018
sp_UserOfflineSmall Offline
6
May 20, 2020 - 6:58 pm
sp_Permalink sp_Print

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.

Avatar
damien lemaire

Active Member
Members
Level 0
Forum Posts: 5
Member Since:
May 19, 2020
sp_UserOfflineSmall Offline
7
May 21, 2020 - 5:58 am
sp_Permalink sp_Print

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

Avatar
Philip Treacy
Admin
Level 10
Forum Posts: 1529
Member Since:
October 5, 2010
sp_UserOfflineSmall Offline
8
May 21, 2020 - 9:40 am
sp_Permalink sp_Print sp_EditHistory

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

Avatar
damien lemaire

Active Member
Members
Level 0
Forum Posts: 5
Member Since:
May 19, 2020
sp_UserOfflineSmall Offline
9
May 23, 2020 - 1:54 am
sp_Permalink sp_Print

Hi Philip,

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

Regards

Avatar
Philip Treacy
Admin
Level 10
Forum Posts: 1529
Member Since:
October 5, 2010
sp_UserOfflineSmall Offline
10
May 23, 2020 - 9:43 am
sp_Permalink sp_Print

You're welcome.

sp_Feed
Go to top
Forum Timezone: Australia/Brisbane
Most Users Ever Online: 245
Currently Online: Geoff McClure, Riny van Eekelen, David Jernigan, Cassie Bernier
Guest(s) 11
Currently Browsing this Page:
1 Guest(s)
Top Posters:
SunnyKow: 1432
Anders Sehlstedt: 873
Purfleet: 414
Frans Visser: 346
David_Ng: 306
lea cohen: 222
Jessica Stewart: 215
A.Maurizio: 202
Aye Mu: 201
jaryszek: 183
Newest Members:
Abisola Ogundele
MARTYN STERRY
Rahim Lakhani
Ngoc Qui Nguyen
Clement Mansfield
Rose .
Bindu Menon
Baruch Zemer
Purple RainbowBenefactor
MOTH Junkie
Forum Stats:
Groups: 3
Forums: 24
Topics: 6350
Posts: 27773

 

Member Stats:
Guest Posters: 49
Members: 32317
Moderators: 3
Admins: 4
Administrators: Mynda Treacy, Philip Treacy, Catalin Bombea, FT
Moderators: MOTH Support, Velouria, Riny van Eekelen
© Simple:Press —sp_Information

Sidebar

Blog Categories

  • Excel
  • Excel Charts
  • Excel Dashboard
  • Excel Formulas
  • Excel PivotTables
  • Excel Shortcuts
  • Excel VBA
  • General Tips
  • Online Training
  • Outlook
  • Power Apps
  • Power Automate
  • Power BI
  • Power Pivot
  • Power Query
microsoft mvp logo
trustpilot excellent rating
Secured by Sucuri Badge
MyOnlineTrainingHub on YouTube Mynda Treacy on Linked In Mynda Treacy on Instagram Mynda Treacy on Twitter Mynda Treacy on Pinterest MyOnlineTrainingHub on Facebook
 

Company

  • About My Online Training Hub
  • Disclosure Statement
  • Frequently Asked Questions
  • Guarantee
  • Privacy Policy
  • Terms & Conditions
  • Testimonials
  • Become an Affiliate

Support

  • Contact
  • Forum
  • Helpdesk - For Technical Issues

Copyright © 2023 · My Online Training Hub · All Rights Reserved. Microsoft and the Microsoft Office logo are trademarks or registered trademarks of Microsoft Corporation in the United States and/or other countries. Product names, logos, brands, and other trademarks featured or referred to within this website are the property of their respective trademark holders.