VBA - Colouring chart using conditional formatting

buckland015

New Member
Joined
Mar 13, 2018
Messages
6
Hi all,

I have inherited some code that is used to colour code segments in a donut chart based on a RAG status, I am trying to amend it to work on a new piece of data however it isnt working.

So far it is correctly iterating between each segment however isn't changing the colours.

Could anyone please help me to understand why?

Thanks,
Dan

1z3qn20.png
[/IMG]

Code:
Public Sub Main()


Dim ColourCode As String
Dim i As Integer


'how many in each ring?
nRing1 = 2 'regions
nRing2 = 8 'counties
nRing3 = 39 'areas
nRing4 = nRing3 * 4 'KPIs


'which row to start on (less 1)
StartRing1 = 1
StartRing2 = StartRing1 + nRing1 '4
StartRing3 = StartRing2 + nRing2 '13
StartRing4 = StartRing3 + nRing3 '39


    ActiveSheet.ChartObjects("Chart 1").Activate
'Inner ring - Region Generation
    For i = 1 To nRing1
        ColourCode = Cells(i + StartRing1, 3).Text
        ActiveChart.SeriesCollection(1).Select
        ActiveChart.SeriesCollection(1).Points(i).Select
        
        Call RAG(ColourCode)
    Next i
    
'2nd ring - County Generation
    For i = 1 To nRing2
        ColourCode = Cells(i + StartRing2, 3).Text
        ActiveChart.SeriesCollection(2).Select
        ActiveChart.SeriesCollection(2).Points(i + nRing1).Select
        
        Call RAG(ColourCode)
    Next i
    
'Middle ring - Area Generation
    For i = 1 To nRing3
        ColourCode = Cells(i + StartRing3, 3).Text
        ActiveChart.SeriesCollection(3).Select
        ActiveChart.SeriesCollection(3).Points(i + nRing2 + nRing1).Select
        
        Call RAG(ColourCode)
    Next i




End Sub

Code:
Function RAG(ColourCode As String) As String




    Select Case ColourCode
    Case "DR"
        With Selection.Format.Fill
            .Visible = msoTrue
            .ForeColor.RGB = RGB(192, 0, 0)
            .Transparency = 0
            .Solid
        End With
    Case "R"
     With Selection.Format.Fill
            .Visible = msoTrue
            .ForeColor.RGB = RGB(255, 0, 0)
            .Transparency = 0
            .Solid
        End With
    Case "A"
        With Selection.Format.Fill
            .Visible = msoTrue
            .ForeColor.RGB = RGB(255, 192, 0)
            .Transparency = 0
            .Solid
        End With
    Case "LG"
     With Selection.Format.Fill
            .Visible = msoTrue
            .ForeColor.RGB = RGB(146, 208, 80)
            .Transparency = 0
            .Solid
        End With
    Case "G"
     With Selection.Format.Fill
            .Visible = msoTrue
            .ForeColor.RGB = RGB(0, 176, 80)
            .Transparency = 0
            .Solid
        End With
    Case "No Data"
    With Selection.Format.Fill
        .Visible = msoTrue
        '.ForeColor.ObjectThemeColor = msoThemeColorBackground1
        '.ForeColor.TintAndShade = 0
        '.ForeColor.Brightness = 0
        .ForeColor.RGB = RGB(255, 255, 255)
        .Transparency = 0
        .Solid
    End With
                 
    End Select


End Function
 
Last edited by a moderator:

Excel Facts

How to find 2nd largest value in a column?
MAX finds the largest value. =LARGE(A:A,2) will find the second largest. =SMALL(A:A,3) will find the third smallest
I don't know if this will help or not, however...

Try including the selection to be worked on as an argument in the RAG routine...

Code:
Call RAG(Selection, ColourCode)

Then, your sub (I suggest that you change it from a Function to a Sub (since you don't actually return anything with the function.)

Code:
Sub RAG(BYREF Selection, ColourCode as String)
   'your stuff  
End sub
 
Upvote 0
Hi Pat - Thanks for getting back to me, I did just manage to make it work as I found that I had shifted the column for the RGB away from column C so the line ColourCode = Cells(i + StartRing1, 3).Text was not working.

I will have a play with your suggestions as well this evening. Hopefully they will help me get a better understanding of how this all works!
 
Upvote 0

Forum statistics

Threads
1,215,356
Messages
6,124,475
Members
449,164
Latest member
Monchichi

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