<<Convert Excel Spreadsheets to Web Pages | Trading Software That Operates Within Excel | Convert Excel, Access & Other Databases | Merge Excel Files>>
Ozgrid, Experts in Microsoft Excel Spreadsheets

Excel Charts : Color XY Scatter Points. XY Scatter Coloration Plot

| | Information Helpful? Why Not Donate.

TRY OUT: Smart-VBA | Code-VBA | Analyzer-XL | Downloader-XL | Trader-XL| More Free Downloads.. Best Value: Finance Templates Bundle

Also see our huge range of Charting Software . Got a Excel Chart question? Use our FREE Excel Help

The chart in both cases is a standard xy scatter plot where the plot order of each data point determines the color of the marker.

The first chart sets the data markers color but due to the limit of the color palette it produces a more stepped coloration.

The second chart uses an autoshape as a custom marker. The color of the custom marker is not restricted by the color palette so the coloration is smoother.

The code sets the data markers color according to the points order within the data series. You can specify the Start and finish colors and the number of steps between. In order for the code below to work you will need to create 2 charts and insert a autoshape onto a worksheet. The autoshape should be named Marker.

To name the autoshape select it and enter the new name in the Name box next to the formula bar.

The code allows you to specify the Start and finish color of your spectrum. You can also specify the number of colors to define within the span.Code module: MSpectrum

Option Explicit

Sub Main()

    Dim clsSpectrum As CSpectrum
    
    Set clsSpectrum = New CSpectrum
    With clsSpectrum
        .Count = 56                       ' number of colours in spectrum
        .Start Color = RGB(0, 0, 255) ' Blue 
        .EndColor = RGB(255, 0, 0)   ' Red
        .CreateSpectrum
    End With

    UsingMarkers clsSpectrum, ActiveSheet.ChartObjects(1).Chart
    UsingCustomMarkers clsSpectrum, ActiveSheet.ChartObjects(2).Chart
    
End Sub

Sub UsingMarkers(Spectrum As CSpectrum, Cht As Chart)
'
' Using builtin color palette
'
    Dim lngIndex As Long
    Dim intPoint As Integer
    
    With Cht
        With .SeriesCollection(1)
            For intPoint = 1 To .Points.Count
                lngIndex = intPoint * (Spectrum.Count / .Points.Count)
                With .Points(intPoint)
                    .MarkerBackgroundColor = Spectrum.SpectrumColor(lngIndex)
                    .MarkerForegroundColor = Spectrum.SpectrumColor(lngIndex)
                End With
            Next
        End With
    End With
    
End Sub
Sub UsingCustomMarkers(Spectrum As CSpectrum, Cht As Chart)
'
' Use a shape as a custom marker
'
    Dim shpMarker As Shape
    Dim lngIndex As Long
    Dim intPoint As Integer
    
    Application.ScreenUpdating = False
    Set shpMarker = ActiveSheet.Shapes("Marker")
    With Cht
        With .SeriesCollection(1)
            For intPoint = 1 To .Points.Count
                lngIndex = intPoint * (Spectrum.Count / .Points.Count)
                shpMarker.Fill.ForeColor.RGB = Spectrum.SpectrumColor(lngIndex)
                shpMarker.CopyPicture
                .Points(intPoint).Paste
            Next
        End With
    End With
    Application.ScreenUpdating = True
    
End Sub

Class module: CSpectrum

Option Explicit

Private Enum enumSpectrum
    Red = 1
    Green
    Blue
End Enum

Private m_lngStart Color As Long
Private m_lngEndColor As Long
Private m_lngCountColor As Long
Private m_lngSpectrum() As Long
Private m_blnUpdatedSpectrum As Boolean
Public Property Let Count(RHS As Long)
    If RHS < 1 Then
        m_lngCountColor = 1
    ElseIf RHS > 255 Then
        m_lngCountColor = 255
    Else
        m_lngCountColor = RHS
    End If
    
    m_blnUpdatedSpectrum = False
End Property
Public Property Get Count() As Long
    Count = m_lngCountColor
End Property
Public Sub CreateSpectrum()
'
' Calculate the spread of colours
'
    Dim lngIndex As Long
    Dim lngColor As Long
    Dim sngSpreadRed As Single
    Dim sngSpreadGreen As Single
    Dim sngSpreadBlue As Single
    Dim sngRed As Single
    Dim sngGreen As Single
    Dim sngBlue As Single
    
    If m_lngCountColor = 0 Then
        m_lngCountColor = 2
        ReDim m_lngSpectrum(m_lngCountColor) As Long
        m_lngSpectrum(1) = m_lngStart Color
        m_lngSpectrum(2) = m_lngEndColor
        m_blnUpdatedSpectrum = True
    End If
    
    ReDim m_lngSpectrum(m_lngCountColor) As Long
    m_lngSpectrum(1) = m_lngStart Color
    m_lngSpectrum(m_lngCountColor) = m_lngEndColor
    sngRed = CSng(m_Color2RGB(m_lngSpectrum(1), Red))
    sngGreen = CSng(m_Color2RGB(m_lngSpectrum(1), Green))
    sngBlue = CSng(m_Color2RGB(m_lngSpectrum(1), Blue))
    
    sngSpreadRed = (m_Color2RGB(m_lngSpectrum(m_lngCountColor), Red) - sngRed) / m_lngCountColor
    sngSpreadGreen = (m_Color2RGB(m_lngSpectrum(m_lngCountColor), Green) - sngGreen) / m_lngCountColor
    sngSpreadBlue = (m_Color2RGB(m_lngSpectrum(m_lngCountColor), Blue) - sngBlue) / m_lngCountColor
    
    For lngIndex = 2 To m_lngCountColor - 1
        sngRed = sngRed + sngSpreadRed
        sngGreen = sngGreen + sngSpreadGreen
        sngBlue = sngBlue + sngSpreadBlue
        m_lngSpectrum(lngIndex) = RGB(CInt(sngRed), CInt(sngGreen), CInt(sngBlue))
    Next
    
    m_blnUpdatedSpectrum = True
    
End Sub
Private Function m_Color2RGB(Color As Long, Element As enumSpectrum) As Long
'
' Return RGB element for given color
'
    Select Case Element
    Case enumSpectrum.Red
        m_Color2RGB = Color \ 256 ^ 0 And 255
    Case enumSpectrum.Green
        m_Color2RGB = Color \ 256 ^ 1 And 255
    Case enumSpectrum.Blue
        m_Color2RGB = Color \ 256 ^ 2 And 255
    End Select
    
End Function

Public Property Get SpectrumColor(Index As Long) As Long
    If Index > m_lngCountColor Then
        SpectrumColor = m_lngSpectrum(m_lngCountColor)
    ElseIf Index < 1 Then
        SpectrumColor = m_lngSpectrum(1)
    Else
        SpectrumColor = m_lngSpectrum(Index)
    End If
End Property
Public Property Let Start Color(RHS As Long)
    m_lngStart Color = RHS
    m_blnUpdatedSpectrum = False
End Property
Public Property Let EndColor(RHS As Long)
    m_lngEndColor = RHS
    m_blnUpdatedSpectrum = False
End Property
Public Property Get Start Color() As Long
    Start Color = m_lngStart Color
End Property
Public Property Get EndColor() As Long
    EndColor = m_lngEndColor
End Property
Private Sub Class_Initialize()

    ' default settings
    m_lngCountColor = 56
    m_lngStart Color = RGB(0, 0, 255)  ' blue
    m_lngEndColor = RGB(255, 0, 0)    ' red
    m_blnUpdatedSpectrum = False
    CreateSpectrum
    
End Sub
 

Download Example workbook with data & Excel VBA Code.

Back to Excel Charts Index

Also see our huge range of Charting Software

New & Less Than You Think:List Managers | Working With Excel Sheets In VBA |Excel Charting Lessons | Conditional Row Delete

Excel Dashboard Reports & Excel Dashboard Charts 50% Off Become an ExcelUser Affiliate & Earn Money

Special! Free Choice of Complete Excel Training Course OR Excel Add-ins Collection on all purchases totaling over $64.00. ALLpurchases totaling over $150.00 gets you BOTH! Purchases MUST be made via this site. Send payment proof to [email protected] 31 days after purchase date.


Instant Download and Money Back Guarantee on Most Software

Try out:Analyzer XL |Downloader XL |Smart VBA |Trader XL Pro (best value) |ConsoXL | MergeXL | O2OLAP for Excel | MORE>>

Excel Trader PackageTechnical Analysis in Excel With $139.00 of FREE software!

Microsoft � and Microsoft Excel � are registered trademarks of Microsoft Corporation. OzGrid is in no way associated with Microsoft

Some of our more popular products are below...
Convert Excel Spreadsheets To Webpages | Trading In Excel | Construction Estimators | Finance Templates & Add-ins Bundle | Code-VBA | Smart-VBA | Print-VBA | Excel Data Manipulation & Analysis | Convert MS Office Applications To...... | Analyzer Excel | Downloader Excel | MSSQL Migration Toolkit | Monte Carlo Add-in | Excel Costing Templates