cellMatrix.net
Spreadsheet Modeling and Related Topics

About

Formulas, Charts, and Models Created with Microsoft Excel.
More . . .

Statistics

  • Total Entries - 102
  • Current Viewers - 11

Categories

Recent Comments

Syndicate

Validate

Flag XY Duplicates with Different Formatting

A recent post to the Microsoft Excel Charting Discussion Group asks . . . how can I change the point size of all XY chart values that are duplicates? Assuming an embedded XY chart, I responded with the procedure below. Activate (click on) the embedded chart and run the macro:

Sub ShowXYDuplicatePoints()

    Application.ScreenUpdating = False

    Dim Cht As Chart
    Dim Srs As Series
    Dim Pt As Points
    Dim nPts As Long, iPt As Long
    Dim Test As Variant
    Dim UniqueValues As New Collection

    Set Cht = ActiveChart

    For Each Srs In Cht.SeriesCollection
        With Srs
            nPts = .Points.Count
            For iPt = 1 To nPts
                Test = Srs.XValues(iPt) & Srs.Values(iPt)
                UniqueValues.Add Acct, CStr(Test)
                On Error GoTo ErrHandler:
                If iPt + 1 > nPts Then
                    ActiveChart.Deselect
                    Exit Sub
                End If
                Label1:
            Next
        End With
    Next Srs

ErrHandler:
    Srs.Points(iPt).MarkerSize = 10
    Srs.Points(iPt).MarkerBackgroundColorIndex = 3
    Srs.Points(iPt).MarkerForegroundColorIndex = 3
    If iPt + 1 > nPts Then
        ActiveChart.Deselect
        Exit Sub
    End If
    Resume Label1:

End Sub

The procedure works by looping through all of the point values within each series in the chart. As the macro loops, each point value is loaded into the UniqueValues array. Because the UniqueValues array only accepts unique values, any duplicates are automatically kicked out and run through the error handling procedure.

The formatting can be reset with the following procedure.

Sub ResetXY()

    Application.ScreenUpdating = False

    Dim Cht As Chart
    Dim Srs As Series
    Dim Pt As Points
    Dim nPts As Long, iPt As Long
    Set Cht = ActiveChart

    For Each Srs In Cht.SeriesCollection
        With Srs
            nPts = .Points.Count
            For iPt = 1 To nPts
                Srs.Points(iPt).MarkerSize = 5
                Srs.Points(iPt).MarkerBackgroundColorIndex = 11
                Srs.Points(iPt).MarkerForegroundColorIndex = 11
            Next
        End With
    Next Srs

    ActiveChart.Deselect

End Sub



Comment Form

Name: (Required)
E-Mail Address: (Optional)
Location: (Optional)
Web Site Address: (Optional)

Remember my personal information?
Notify me of follow-up comments?

Before submitting your comment, please enter the phrase you see below: