CODEWITHSUNDEEP
vbaexcelgraphexcel-charts
H.Cani
H.Cani

Reputation: 31

How can I vary the marker colors in an Excel graph?

I have an Excel line graph with markers.

enter image description here

I need to change the color of the marker if it is below a threshold.
For example, the graph below is monthly results where the markers are above a threshold. If the results are below a certain point, I need the marker to change color (2nd graph).

enter image description here

I know how to change the marker colors manually. Can this be done automatically? Thank you, in advance, for your help.

Upvotes: 2

Views: 519

Answers (1)

Dy.Lee
Dy.Lee

Reputation: 7567

test bellow.

Sub setMarkerColor()
    Dim myCht As ChartObject
    Dim n  As Long
    Dim adr As String
    Dim p As Double

    Application.ScreenUpdating = False
    For Each myCht In ActiveSheet.ChartObjects
        With myCht.Chart
            adr = .SeriesCollection(1).Formula '<~~ First grapth, if 2nd change to .SeriesCollection(2).Formula
            adr = Split(adr, ",")(2)
            For n = 1 To Range(adr).Cells.Count
               p = Range(adr)(n)
               If p < 15 Then '<~~ set value 15
                   '.SeriesCollection(1).Points(n).HasDataLabel = True
                   With .SeriesCollection(1).Points(n) '<~~ First grapth, if 2nd change to .SeriesCollection(2).Points(n)
                    .MarkerForegroundColor = RGB(0, 255, 0)
                    .MarkerBackgroundColor = RGB(255, 0, 0)
                    End With
               End If
            Next n
        End With
    Next myCht
    Application.ScreenUpdating = True
 End Sub

edition

Sub setMarkerColor()
    Dim myCht As ChartObject
    Dim n  As Long
    Dim adr As String
    Dim p As Double
    Dim myVal As Long
    Application.ScreenUpdating = False
    For Each myCht In ActiveSheet.ChartObjects
        With myCht.Chart
            adr = .SeriesCollection(1).Formula '<~~ First grapth, if 2nd change to .SeriesCollection(2).Formula
            adr = Split(adr, ",")(2)
            For n = 1 To Range(adr).Cells.Count
               p = Range(adr)(n)
               If p >= 0.99 Then '<~~ set value 0.99
                    myVal = RGB(0, 255, 0)
                Else
                    myVal = RGB(255, 0, 0)
                End If
                   '.SeriesCollection(1).Points(n).HasDataLabel = True
                   With .SeriesCollection(1).Points(n) '<~~ First grapth, if 2nd change to .SeriesCollection(2).Points(n)
                    .MarkerForegroundColor = RGB(0, 255, 0)
                    .MarkerBackgroundColor = myVal
                    End With

            Next n
        End With
    Next myCht
    Application.ScreenUpdating = True
 End Sub

Upvotes: 1

Related Questions