colour xy scatter chart points based upon sheets rgb values

[nicksoph]

I am using Office 2010.

I have a scatter graph which uses two cells in a row as the x and y . Each row also contains three cells which give an RGB value of the colour I would like each individual scatter point to be.

Is it possible to do this?
Where might I start? - I have used VBA a little and mainly with Coreldraw rather than the Office apps.

Thanks for any advice,
nick

 

[pbornemeier]

Add the R, G, B values as the 2nd, 3rd and 4th series then run the following code:

Option Explicit
 
Sub ColorScatterPlot()
    'Create a scatter plot with X as horizontal axis and
    'Y, R, G, B plotted on the vertical axis
 
    Dim lX As Long
    Dim iRed As Integer
    Dim iGreen As Integer
    Dim iBlue As Integer
 
    ActiveSheet.ChartObjects(1).Select
    For lX = 2 To 4
        ActiveChart.SeriesCollection(lX).ApplyDataLabels AutoText:=True, LegendKey:=False
    Next
 
    For lX = 1 To ActiveChart.SeriesCollection(1).Points.Count
        iRed = ActiveChart.SeriesCollection(2).Points(lX).DataLabel.Text
        iGreen = ActiveChart.SeriesCollection(3).Points(lX).DataLabel.Text
        iBlue = ActiveChart.SeriesCollection(4).Points(lX).DataLabel.Text
 
        With ActiveChart.SeriesCollection(1).Points(lX).Format.Fill
            .Visible = msoTrue
            .ForeColor.RGB = RGB(iRed, iGreen, iBlue)
            .BackColor.RGB = RGB(iRed, iGreen, iBlue)
        End With
 
    Next
 
    For lX = 4 To 2 Step -1
        ActiveChart.SeriesCollection(lX).Delete
    Next
End Sub

 

[Rasm]

I understood that all datapoints are in same series - but you want some points to be different colors that other-hope that is right

       PlotCounter=1 ' The number of the series to plot
       For i = 1 To 100 ' you manage this part
            .SeriesCollection(PlotCounter).Points(i).Border.Color = vbCyan
        Next i
        For i = 101 To 200
            .SeriesCollection(PlotCounter).Points(i).Border.Color = vbGreen
        Next i

 

[nicksoph]

Thank you I am so pleased it can be done and thank you for sharing how.

Yes I think you have the idea - but rather than a named vb colour each row has 5 cells the first two give the x and y co ordinate of a point and the next 3 give the colour the point should be as three numbers between 0 and 255 representing the colour as RGB.
Example 4 points shown below. (Cells separated by a space)
0.00 0.00 0 0 0
-39.39 6.97 0 255 0
37.73 24.00 0 0 255
-12.72 -47.31 153 0 204

I havnt looked at the syntax of the commands but I think I will be able to take what you have done and amend to something like

PlotCounter=1 ' The number of the series to plot
For i = 1 To 20 ' first 20 rows in sheet

.SeriesCollection(PlotCounter).Points(i).Border.Color =

vbRGB (cell(i,3),cell(i,4),cell(i,5))

Next i


which I hope will colour each point based upon the values in the 3rd,4th and fifth columns.

Thanks again

 

[Rasm]

Jepper - I just used vbcolors for my own simplicity sake - but you got the idea - perfect - good luck

 

[nicksoph]

Thanks Phil,

I am very ignorant in relation to VB and not able to understand much of what is going on in your code. Having created the extra series I have tried running it but I get an error on running it which Im not able to troubleshoot. The macro gives an invalid parameter error on the line
iRed = ActiveChart.SeriesCollection(2).Points(lX).DataLabel.Text
Thanks
nick

 

[nicksoph]

Tried this but get coloured lines between points and not the points themselves. Where am I going wrong?

Sub colplot()

Dim i As Double, plotcounter As Double

plotcounter = 1 ' The number of the series to plot
       '
       For i = 1 To 20 ' first 20 rows in sheet
       ActiveChart.SeriesCollection(plotcounter).Points(i).Border.Color = RGB(Cells(i, 3), Cells(i, 4), Cells(i, 5))
       
       Next i
End Sub

 

[nicksoph]

This works - Thanks to both of you

Sub colplot()

Dim i As Double, plotcounter As Double

plotcounter = 1 ' The number of the series to plot
       '
       For i = 1 To 20 ' first 20 rows in sheet
       ActiveChart.SeriesCollection(plotcounter).Points(i).Format.Fill.ForeColor.RGB = RGB(Cells(i, 3), Cells(i, 4), Cells(i, 5))
       
       Next i
End Sub

 

[Rasm]

Here is an example of a XYscatter plot - it uses arrays - but you can change that. Dont know if it helps you - but here it is anyways.

Public Sub AddXYscatterChart()
    
    Dim XVal(8) As Single
    Dim YVal(8) As Single
    Dim minimumX As Single
    Dim maximumX As Single
    Dim NumCharts As Long
   
    XVal(0) = 7.885
    YVal(0) = 7.78800297
    XVal(1) = 11.84
    YVal(1) = 11.82672596
    XVal(2) = 11.986
    YVal(2) = 11.79815865
    XVal(3) = 11.775
    YVal(3) = 11.85401344
    XVal(4) = 12.76
    YVal(4) = 12.8492775
    XVal(5) = 12.399
    YVal(5) = 11.95190716
    XVal(6) = 11.704
    YVal(6) = 11.92477417
    XVal(7) = 10.894
    YVal(7) = 10.90637398
    
    
  
    minimumX = 7
    maximumX = 15
    
    Application.StatusBar = "Making XY scatter chart"
    
    ActiveSheet.ChartObjects.Add Left:=180, Top:=50, Width:=1000, Height:=400
    NumCharts = ActiveSheet.ChartObjects.Count
    If NumCharts > 1 Then
        ActiveSheet.ChartObjects(NumCharts).Left = ActiveSheet.ChartObjects(NumCharts - 1).Left + 20
        ActiveSheet.ChartObjects(NumCharts).Top = ActiveSheet.ChartObjects(NumCharts - 1).Top + 20
        ActiveSheet.ChartObjects(NumCharts).Height = ActiveSheet.ChartObjects(NumCharts - 1).Height
        ActiveSheet.ChartObjects(NumCharts).Width = ActiveSheet.ChartObjects(NumCharts - 1).Width
    End If
    NumCharts = ActiveSheet.ChartObjects.Count
    ActiveSheet.ChartObjects(NumCharts).Activate
    Dim Achart As ChartObject
    Set Achart = ActiveSheet.ChartObjects(NumCharts)
    
    With Achart.Chart     'Set chart properties
        .ChartType = xlXYScatter
        .SeriesCollection.NewSeries
        .HasLegend = True
        .Legend.Position = xlLegendPositionTop
          
        .Axes(xlCategory).MajorTickMark = xlTickMarkOutside
        .Axes(xlValue).MajorTickMark = xlTickMarkOutside
        minimumX = minimumX * 0.95
        maximumX = maximumX * 1.05
       
        .Axes(xlValue).MinimumScale = Format(minimumX, "#####.##")
        .Axes(xlValue).MaximumScale = Format(maximumX, "#####.##")
        
        .Axes(xlCategory).MinimumScale = Format(minimumX, "#####.##")
        .Axes(xlCategory).MaximumScale = Format(maximumX, "#####.##")
        
        .HasTitle = True
        .ChartTitle.Text = "Up to you" 'Adds header for entire chart
        iii = 1
        .SeriesCollection(iii).Values = Array(XVal)
        .SeriesCollection(iii).XValues = Array(YVal)
        
        .SeriesCollection(iii).Name = "Records"
        Selection.Fill.OneColorGradient Style:=msoGradientHorizontal, Variant:=4, Degree:=0.231372549019608
        .SeriesCollection(iii).Border.LineStyle = xlNone
        
        .Axes(xlCategory).HasTitle = True
        .Axes(xlCategory).AxisTitle.Characters.Text = "What you want"
        .Axes(xlValue).HasTitle = True
        .Axes(xlValue).AxisTitle.Characters.Text = "Still your choice"
    End With
    Set Achart = Nothing
    Application.StatusBar = "Completed ---- Making XY scatter chart - Start new Task"
   
End Sub

 

[nicksoph]

Thanks again Rasm, I had set aside the evening to do it and with the help from Phil and you - Im playing spades.
Most appreciated.
Nick