Chart - vba to color scatter plot based on cells color

[mfarr76]

Hello,

I have a macro that will create a scatter plot and then color all the curve to a specific color that I hard code in.

I would like more freedom with this and have the macro color the curves based on the cell color that the series name resides in. The example below would plot the "Michael" curve in blue and so forth.

The vba code below is what I am currently working with.

Any help would be greatly appreciated!!!

Excel 2012

	C	D	E	F
Days

<tbody>
[TD="align: center"]1[/TD]

[TD="bgcolor: #4472C4"]Michael[/TD]
[TD="bgcolor: #FF0000"]Ashley[/TD]
[TD="bgcolor: #FFC000"]Chris[/TD]

[TD="align: center"]2[/TD]
[TD="align: right"]1[/TD]
[TD="align: right"]1582.93[/TD]
[TD="align: right"]2779.2[/TD]
[TD="align: right"]1731.09[/TD]

[TD="align: center"]3[/TD]
[TD="align: right"]2[/TD]
[TD="align: right"]4340.13[/TD]
[TD="align: right"]7057.53[/TD]
[TD="align: right"]4774.47[/TD]

[TD="align: center"]4[/TD]
[TD="align: right"]3[/TD]
[TD="align: right"]4837.4[/TD]
[TD="align: right"]7449.11[/TD]
[TD="align: right"]4869.77[/TD]

</tbody>

Sub CreateChart()

    Dim c As Object
    Dim d As Object
    Dim i As Integer
    
    With activecell.CurrentRegion.Select
        ActiveSheet.Shapes.AddChart2 201, xlXYScatterSmoothNoMarkers
        ActiveSheet.ChartObjects(ActiveSheet.ChartObjects.Count).Name = "Chart1"
        ActiveSheet.ChartObjects("Chart1").Activate
        ActiveChart.Axes(xlValue).Select
        ActiveChart.Axes(xlValue).MinimumScale = 0
        ActiveChart.Legend.Select
        Selection.Delete
    End With
'alternate series colors
    i = 0
    For Each c In ActiveSheet.ChartObjects
        For Each d In c.Chart.SeriesCollection
            If i Mod 2 = 0 Then
                d.Border.ColorIndex = 15
            Else
                d.Border.ColorIndex = 15
            End If
            i = i + 1
            Next d
            Next c
End Sub

​

 

[Domenic]

Maybe something like this...

[color=darkblue]Option[/color] [color=darkblue]Explicit[/color]

[color=darkblue]Sub[/color] CreateChart()

    [color=darkblue]Dim[/color] rChrtData [color=darkblue]As[/color] Range
    [color=darkblue]Dim[/color] rChrtXVals [color=darkblue]As[/color] Range
    [color=darkblue]Dim[/color] rChrtVals [color=darkblue]As[/color] Range
    [color=darkblue]Dim[/color] rSeriesName [color=darkblue]As[/color] Range
    [color=darkblue]Dim[/color] lCol [color=darkblue]As[/color] [color=darkblue]Long[/color]
    
    [color=darkblue]Set[/color] rChrtData = ActiveCell.CurrentRegion
    
    [color=darkblue]With[/color] rChrtData
        [color=darkblue]Set[/color] rChrtXVals = .Offset(1, 0).Resize(.Rows.Count - 1, 1)
        [color=darkblue]Set[/color] rChrtVals = .Offset(1, 1).Resize(.Rows.Count - 1, .Columns.Count - 1)
    [color=darkblue]End[/color] [color=darkblue]With[/color]
    
    [color=darkblue]With[/color] ActiveSheet.Shapes.AddChart2(201, xlXYScatterSmoothNoMarkers)
        .Name = "Chart1"
        [color=darkblue]With[/color] .Chart
            [color=darkblue]Do[/color] [color=darkblue]While[/color] .SeriesCollection.Count > 0
                .SeriesCollection(1).Delete
            [color=darkblue]Loop[/color]
            [color=darkblue]For[/color] lCol = 1 [color=darkblue]To[/color] rChrtVals.Columns.Count
                [color=darkblue]With[/color] .SeriesCollection.NewSeries
                    .XValues = rChrtXVals
                    .Values = rChrtVals.Columns(lCol)
                    [color=darkblue]Set[/color] rSeriesName = rChrtVals.Columns(lCol).Offset(-1).Resize(1)
                    .Name = rSeriesName.Value
                    .Format.Line.ForeColor.RGB = rSeriesName.Interior.Color
                [color=darkblue]End[/color] [color=darkblue]With[/color]
            [color=darkblue]Next[/color] lCol
            .Legend.Delete
        [color=darkblue]End[/color] [color=darkblue]With[/color]
    [color=darkblue]End[/color] [color=darkblue]With[/color]

[color=darkblue]End[/color] [color=darkblue]Sub[/color]

Hope this helps!

 

[mfarr76]

Domenic,

That is exactly what I was trying to achieve.

Thank you for your time!!

 

[Domenic]

You're very welcome!

Cheers!