Prevent Line from Continuing Point-to-Point (Non-continuous) On Scatter Plot in VBA

[bemp87]

I have a scatter plot that is working the way I would except for when I set the lines property to msoTrue it creates a line vertically for each point on the x-axis but also then connects one point to the next as shown in the attached image. The goal is to make it where the line will stop at the end of each point and not connect to the next. I am not sure what I am doing wrong here.

here is my full code:

Sub SortDataAndAssignSizeNumerical()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim i As Long
    Dim brandSize As String
    Dim sizeCounter As Double
    Dim sizeValues As Object

    Set ws = ThisWorkbook.Worksheets("Sheet3") ' Replace "Sheet3" with your actual sheet name

    lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row

    ' 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

    ' Use Dictionary to store and assign Size Numerical values
    Set sizeValues = CreateObject("Scripting.Dictionary")

    ' Initialize sizeCounter
    sizeCounter = 1

    For i = 2 To lastRow
        brandSize = ws.Cells(i, 5).value
        If Not sizeValues.Exists(brandSize) Then
            sizeValues.Add brandSize, sizeCounter
            sizeCounter = sizeCounter + 2
        End If
        ws.Cells(i, 6).value = sizeValues(brandSize)
    Next i
End Sub


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
    
    ' 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
    Dim pointsCount As Long
    pointsCount = scatterSeries.Points.Count
    For i = 1 To pointsCount
        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
      [COLOR=rgb(184, 49, 47)]  scatterSeries.Points(i).Format.Line.Visible = msoTrue
        scatterSeries.Points(i).Format.Line.ForeColor.RGB = RGB(230, 0, 0)[/COLOR]
        ' 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

Function GetRandomRGBColor() As Long
    Dim R As Integer, G As Integer, B As Integer
    'Debug.Print Int(Application.WorksheetFunction.RandBetween(0, 256) * Rnd)
    'Do
        R = Int(Application.WorksheetFunction.RandBetween(0, 256))
        G = Int(Application.WorksheetFunction.RandBetween(0, 256))
        B = Int(Application.WorksheetFunction.RandBetween(0, 256))
    'Loop While (R + G + B) < 150 ' Ensure the color is not too light
    GetRandomRGBColor = RGB(R, G, B)
End Function




Sub MainProcedure()
    ' Call the procedure to sort data and assign Size Numerical values
    SortDataAndAssignSizeNumerical
    
    ' Call the procedure to create the scatter plot with data labels
    CreateScatterPlotWithUniqueBrandColors
End Sub

Looking at the highlighted code above (in red) I need a dynamic way to make the line break so it doesn't carry over to the next point as shown in the image.

 

[Jon Peltier]

Here is a way which is easier and more flexible than VBA.

I've made a data set that causes the same issue as yours. Columns A and B are plotted in Chart 1. I have added formulas in column B that give me some custom error bar values. The formula in C3, filled down, is:

=IF(A2=A1,B1-B2,0)

Chart 2: Remove the lines from the series (format line - no line), leaving the markers alone.

Chart 3: Click the '+' icon next to the chart, click the '>' next to Error Bars, choose More Options... Select Direction - Plus, End Style - No Cap, and Error Amount - Custom. Click Specify Value, for positive error bars, select the range of data in column C (C2:C17), and for negative error bars, clear the box and simply type zero.

Chart 4: Format the line the way the original lines were.