VBA Macro - Set graph data point fill colour

[drsom]

Hi,


Very new to vba (well been 5 years) so please advise if there is anything missing or confusing.


I am trying to create a time series graph (bar graph) which illustrates a timeline of when projects will be started. I am able to create this graph by the engineer placing the year and quarter into a column which will then be graphed accordingly. The next phase of this spreadsheet is for the engineer to place a status into a column which will automatically change then data point colour to a predefined colour.


Table
[TABLE="width: 843"]
<colgroup><col><col><col><col><col><col><col></colgroup><tbody>[TR]
[TD]Project[/TD]
[TD]year[/TD]
[TD]quarter[/TD]
[TD]status[/TD]
[TD]start[/TD]
[TD]end[/TD]
[TD]length[/TD]
[/TR]
[TR]
[TD]Network Switching Refresh[/TD]
[TD="align: right"]2013[/TD]
[TD]q2[/TD]
[TD]review[/TD]
[TD="align: right"]1/04/2013[/TD]
[TD="align: right"]30/06/2013[/TD]
[TD="align: right"]90[/TD]
[/TR]
[TR]
[TD]Network Box Upgrade[/TD]
[TD="align: right"]2013[/TD]
[TD]q3[/TD]
[TD]review[/TD]
[TD="align: right"]1/07/2013[/TD]
[TD="align: right"]30/09/2013[/TD]
[TD="align: right"]91[/TD]
[/TR]
[TR]
[TD]Network segregation (VLANS)[/TD]
[TD="align: right"]2013[/TD]
[TD]q1[/TD]
[TD]complete[/TD]
[TD="align: right"]1/01/2013[/TD]
[TD="align: right"]30/03/2013[/TD]
[TD="align: right"]88[/TD]
[/TR]
[TR]
[TD]Additional Wireless Access Points[/TD]
[TD="align: right"]2013[/TD]
[TD]q4[/TD]
[TD]rejected[/TD]
[TD="align: right"]1/10/2013[/TD]
[TD="align: right"]30/12/2013[/TD]
[TD="align: right"]90[/TD]
[/TR]
[TR]
[TD]Wireless upgrade for Guest/BYOD[/TD]
[TD="align: right"]2013[/TD]
[TD]q1[/TD]
[TD]complete[/TD]
[TD="align: right"]1/01/2013[/TD]
[TD="align: right"]30/03/2013[/TD]
[TD="align: right"]88[/TD]
[/TR]
[TR]
[TD]Further coverage analysis and installation ongoing[/TD]
[TD="align: right"]2013[/TD]
[TD]q1[/TD]
[TD]evaluate[/TD]
[TD="align: right"]1/01/2013[/TD]
[TD="align: right"]30/03/2013[/TD]
[TD="align: right"]88[/TD]
[/TR]
[TR]
[TD]13 new AP's being wired over 2013 term 2[/TD]
[TD="align: right"]2014[/TD]
[TD]q1[/TD]
[TD]approved[/TD]
[TD="align: right"]1/01/2014[/TD]
[TD="align: right"]30/03/2014[/TD]
[TD="align: right"]88[/TD]
[/TR]
[TR]
[TD]Additional fibre rollout throughout school.[/TD]
[TD="align: right"]2013[/TD]
[TD]q2[/TD]
[TD]approved[/TD]
[TD="align: right"]1/04/2013[/TD]
[TD="align: right"]30/06/2013[/TD]
[TD="align: right"]90[/TD]
[/TR]
[TR]
[TD]13 new AP's being wired over 2013 term 2[/TD]
[TD="align: right"]2013[/TD]
[TD]q2[/TD]
[TD]approved[/TD]
[TD="align: right"]1/04/2013[/TD]
[TD="align: right"]30/06/2013[/TD]
[TD="align: right"]90[/TD]
[/TR]
</tbody>[/TABLE]



The approach i have taken to date is to code a vba macro which looks for predefined text in a column (status) and if matches then set cell fill colour, which works. I then want to graph this data point to be set to the same fill colour. To date all i am able to do is change the fill colour of the cell which does not cross over to the graph.


Image of current Graph

Thanks,
Daniel

 

[apo]

Hi..

I have done something similar.. in my case.. it is a Shift Viewer (Stacked Bar Chart showing Employee Shifts).

The different tasks that can be allocated to a shift (and displayed as text on the bar) are different colors..

You will obviously need to change variables like sheet names and SeriesCollection values etc..

The code below sets the color of the First shift bars.. (SeriesCollection(2)).

FYI.. The second shift bars are SeriesCollection(4)... SeriesCollection (1) and (3) are invisible...

'************************************
'Set Color of Each Tasks Bar based on Data Label text
'First Shift
'************************************
  
    Dim rName As Range
    Dim iName As Long
    Dim vName As Variant
    Dim iPoint As Long
    Dim vChrValues As Variant
    
    Dim UserColor As Long
    
    Set rName = Worksheets("Tasks").Range("TaskSettings")
    vName = rName.Value
     


    With Sheets(dayTemp & "Chart").ChartObjects(1).Chart.SeriesCollection(2)
        vChrValues = .XValues
        
        For iPoint = LBound(vChrValues) To UBound(vChrValues)
        For iName = 1 To UBound(vName)
            
                If vName(iName, 1) = .Points(iPoint).DataLabel.Text Then
                
                .Points(iPoint).Interior.Color = vName(iName, 2)
  
                End If
                If iName = UBound(vName) Then Exit For
                 
                 If iName >= UBound(vName) Then Exit For
        Next
        Next
        
    End With

This is what it does..

[/URL][/IMG]