Change bar color based on value in chart

Raymond_de_Rozario

New Member
Joined
Aug 10, 2021
Messages
8
Office Version
  1. 2016
Platform
  1. Windows
tabel_grafiek.png


Good afternoon.

I've looked on all kinds of forums, looked at maybe 100 Youtube video's, but I can't seem to find the answer I'm looking for.
In a Access database I made, an output (XLSX) file is generated which is used as an source file for a XLSM file I made with a table and a chart (Gantt like).
I made the chart using this video. All is working as it should and the chart even automatically updates, when "Datum_begin" (start date) or "Datum_eind" (end date) are altered.

What would be ideal if the corresponding bar would be colored by "Prioriteit" (priority).

1 = red
2 = yellow
3 = blue
? = white

I already found this playlist, but it's not helping me either.
I can't seem to find the answer. Your help would really be appreciated.
 

Excel Facts

Who is Mr Spreadsheet?
Author John Walkenbach was Mr Spreadsheet until his retirement in June 2019.
Here's another screenshot that might be helpfull.

Thanks in advance,

Ray
 

Attachments

  • tabel_grafiek 2.png
    tabel_grafiek 2.png
    131.8 KB · Views: 9
Upvote 0
I suggest solution like:
Create range with colour settings, as you said 1, 2, 3, 4 etc and set background cell colour as you want to colouring bars.
As I understand you want to colouring bars according to Priority value so we have to take priority value, find it in colour setting range as above and colouring particular bar.
So try this code (I've got set as Worksheet_change but you can trigger as you wish):

VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)
   Dim MyChart As Chart
   Dim c As Range
   Set MyChart = ActiveSheet.ChartObjects(1).Chart
  
   Dim ser As Series
   Set ser = MyChart.SeriesCollection(1)
  
   Dim sourceRange As Range
   Set sourceRange = Application.Range(Split(ser.Formula, ",")(2))
  
   Dim n As Long
   For n = 1 To ser.Points.Count
        With Worksheets(1).Range("H2:H10")  ' that's column with values and colours
            Set c = .Find(sourceRange.Cells(n).Offset(0, 1).Value, LookIn:=xlValues)   '  cells(n) is a cell with chart value so we will take value of priority from next column
            If Not c Is Nothing Then
                ser.Points(n).Interior.Color = c.Interior.Color    ' set particular colour into particular bar / column etc. depends on chart type
            End If
        End With
   Next
End Sub

For simple chart it looks like:

1628596305248.png
 
Upvote 0
Thank you for the quick reply. I've inserted the code you wrote and made an extra column with the colors (changed the code to the corresponding columns) , but it doesn't change the colors of my bar chart.

I have even put the VBA code in a new Excel sheet, but I can't seem to get it to work.
 
Upvote 0
Did you run macro? Did you check reference addresses? Did you put it into any worksheet event?
Can you attached your file? or sample of?
 
Upvote 0
I put the code under "Private Sub Worksheet_Change(ByVal Target As Range)". I'm a beginner in VBA. How do I check the reference addresses?

Here are the file on my drive
 
Upvote 0
Ok so try this code:

VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)
   Dim MyChart As chart
   Dim c As Range
   Set MyChart = ActiveSheet.ChartObjects(1).chart
 
   Dim ser As series
   Set ser = MyChart.SeriesCollection(2)   ' that fixed for proper data series
 
   Dim sourceRange As Range
   Set sourceRange = Application.Range(Split(ser.Formula, ",")(2))
 
   Dim n As Long
   For n = 1 To ser.Points.Count
        With Worksheets(1).Range("M2:M5")
            Set c = .Find(sourceRange.Cells(n).Offset(0, -4).Value, LookIn:=xlValues)     'that fixed offset in relation of series data
            If Not c Is Nothing Then
                ser.Points(n).Interior.Color = c.Interior.Color
            End If
        End With
   Next
End Sub

should works

1628607228132.png
 
Upvote 0
Solution
You are my absolute hero! Thank you so much. I've discovered a "flaw" in my program. When a priority is not yet defined, it's given a "?". I guess the easiest way is to replace it with a "4".
 
Upvote 0
Happy to help.
You can change this part a bit to be sure that in case of missing priority bar will get colour (black as example):

VBA Code:
If Not c Is Nothing Then
                ser.Points(n).Interior.Color = c.Interior.Color
else
                ser.Points(n).Interior.Color =vbBlack
End If
 
Upvote 0

Forum statistics

Threads
1,213,527
Messages
6,114,150
Members
448,552
Latest member
WORKINGWITHNOLEADER

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