Search code examples
excelvbascatter-plot

Break Continuous Line in Excel VBA Scatter Plot


I have a scatter plot that I am creating in VBA and have set the Line for the series which is working perfectly except for the line is continuous from point-to-point, rather than stop at the end of each point. In other words, the ideal solution would result in a single vertical line for each Series 'Point' of values.

Here is my vba code for the procedure that creates the chart:

Sub CreateScatterPlotWithUniqueBrandColors()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim chart As ChartObject
    Dim chartSheet As Worksheet
    Dim scatterSeries As series
    Dim i As Long
    
    Set ws = ThisWorkbook.Worksheets("Sheet3") ' Replace "Sheet3" with your actual sheet name
    lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
    
    On Error Resume Next
    Set chartSheet = ThisWorkbook.Sheets("PriceBenchmark")
    On Error GoTo 0
    
    If chartSheet Is Nothing Then
        Set chartSheet = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
        chartSheet.Name = "PriceBenchmark"
    End If
    
    ' Create a new column for the BrandSize values (if not already created)
    If ws.Cells(1, 5).value <> "BrandSize" Then
        ws.Cells(1, 5).value = "BrandSize"
        For i = 2 To lastRow
            ws.Cells(i, 5).value = ws.Cells(i, 1).value & "-" & ws.Cells(i, 3).value
        Next i
    End If
    
    ' Create a new column for the Size Numerical values (if not already created)
    If ws.Cells(1, 6).value <> "Size Numerical" Then
        SortDataAndAssignSizeNumerical
    End If
    
    ' Calculate minimum value for the axis scale
    Dim minValue As Double
    minValue = Application.WorksheetFunction.Min(ws.Range("F2:F" & lastRow))
    
    ' Create scatter plot
    Set chart = chartSheet.ChartObjects.Add(0, 0, chartSheet.Cells(1, 1).width, chartSheet.Cells(1, 1).height)
    'Set chart = ws.ChartObjects.Add(100, 100, 600, 300)
    chart.chart.ChartType = xlXYScatter
    chart.chart.HasTitle = True
    chart.chart.ChartTitle.Text = "Price / Value Benchmark"
    
    ' Set axis labels
    chart.chart.Axes(xlCategory).HasTitle = True
    chart.chart.Axes(xlCategory).AxisTitle.Text = "Size:Brand"
    chart.chart.Axes(xlValue).HasTitle = True
    chart.chart.Axes(xlValue).AxisTitle.Text = "Price"
    
    ' Remove gridlines
    chart.chart.Axes(xlCategory).MajorGridlines.Delete
    chart.chart.Axes(xlValue).MajorGridlines.Delete
    
    ' Set minimum scale for category (Size Numerical) axis
    'chart.chart.Axes(xlCategory).MinimumScale = minValue
    chart.chart.Axes(xlCategory).MinimumScale = 0
    
    ' Set Major Unit for Value (Price) Axis
    chart.chart.Axes(xlValue).MajorUnit = 5 ' Adjust this value as needed
    chart.chart.Axes(xlCategory).MajorUnit = 2
    
    ' Set chart size
    'chart.width = 600
    'chart.height = 300
    chart.Left = 0
    chart.Top = 0
    chart.width = 14.17 * 72
    chart.height = 8.78 * 72
    'chart.width = Application.width
    'chart.height = Application.height


    Dim brandColors As Object
    Set brandColors = CreateObject("Scripting.Dictionary")
    
    Dim uniqueBrands As Object
    Set uniqueBrands = CreateObject("Scripting.Dictionary")
    
    For i = 2 To lastRow
        Dim brand As String
        brand = ws.Cells(i, 1).value
        
        If Not brandColors.Exists(brand) Then
            brandColors(brand) = GetRandomRGBColor()
        End If
        
        If Not uniqueBrands.Exists(brand) Then
            uniqueBrands.Add brand, brand
        End If
    Next i
    
    ' Add scatter series data
    Set scatterSeries = chart.chart.SeriesCollection.NewSeries
    scatterSeries.Name = "Scatter Data"
    scatterSeries.Values = ws.Range("D2:D" & lastRow) ' Price column
    scatterSeries.xValues = ws.Range("F2:F" & lastRow) ' Size Numerical column
    
    ' Add data labels for each point
    scatterSeries.HasDataLabels = True
    scatterSeries.HasLeaderLines = True
    scatterSeries.DataLabels.Position = xlLabelPositionRight
    scatterSeries.LeaderLines.Border.Color = RGB(192, 192, 192)
    scatterSeries.LeaderLines.Format.Line.DashStyle = msoLineSysDash
    scatterSeries.LeaderLines.Format.Line.Weight = 0.8
    'scatterSeries.LeaderLines.Border.colorIndex = 5
    Dim pointsCount As Long
    pointsCount = scatterSeries.Points.Count
    'scatterSeries.Points(i).HasLeaderLines = True
    For i = 1 To pointsCount
    
        Set Point = scatterSeries.Points(i)
        
        ' Adjust the data label position by 1 pixel to the right
        labelLeft = Point.DataLabel.Top + 8
        Point.DataLabel.Top = labelLeft
        
        ' Add a leader line
        scatterSeries.ApplyDataLabels
        Point.ApplyDataLabels
        
        'scatterSeries.Points(i).HasLeaderLines = True
        scatterSeries.Points(i).MarkerStyle = xlMarkerStyleCircle
        scatterSeries.Points(i).DataLabel.Text = ws.Cells(i + 1, 2).value ' 'Deal' column
        scatterSeries.Points(i).DataLabel.Font.size = 5
        scatterSeries.Points(i).MarkerSize = 5 ' Adjust this value as needed
        scatterSeries.Points(i).Format.Line.Visible = msoTrue
        scatterSeries.Points(i).Format.Line.ForeColor.RGB = RGB(192, 192, 192)
        scatterSeries.Points(i).Format.Line.DashStyle = msoLineSysDash
        scatterSeries.Points(i).Format.Line.Weight = 0.8
        ' Set point color based on the brand
        scatterSeries.Points(i).Format.Fill.ForeColor.RGB = brandColors(ws.Cells(i + 1, 1).value)
    Next i
    
    ' Hide major tick marks on the x-axis
    chart.chart.Axes(xlCategory).TickLabelPosition = xlTickLabelPositionNone
    chart.chart.Axes(xlValue).TickLabels.Font.size = 4 ' Adjust the font size as needed
    chart.chart.HasLegend = False

    ' Activate the PriceBenchmark sheet
    chartSheet.Activate
    
    ' Set the Zoom on the Chart Sheet
    ActiveWindow.Zoom = 120


End Sub

In this code below where the line is set, i need a way to break the line or something of the sort so that it does not continue to the next point across the x-axis as shown in the image:

scatterSeries.Points(i).Format.Line.Visible = msoTrue
        scatterSeries.Points(i).Format.Line.ForeColor.RGB = RGB(192, 192, 192)
        scatterSeries.Points(i).Format.Line.DashStyle = msoLineSysDash
        scatterSeries.Points(i).Format.Line.Weight = 0.8

Here is the sample data: enter image description here

enter image description here


Solution

  • Slightly different approach running from just the chart data:

    Sub Tester()
        RemoveConnectors ActiveSheet.ChartObjects(1).Chart
    End Sub
    
    
    Sub RemoveConnectors(cht As Chart)
        Dim i As Long, xVals
        With cht.SeriesCollection(1)
            xVals = .XValues
            For i = 1 To UBound(xVals)
                If i > 1 Then
                    If xVals(i) <> xVals(i - 1) Then
                        .Points(i).Format.Line.Visible = msoFalse
                    End If
                End If
            Next i
        End With
    End Sub