CODEWITHSUNDEEP
excelvba
Wren
Wren

Reputation: 79

Adding labels to line chart with VBA

Right now I have the following code to display a line curve. The number of inputs can vary and I want the chart to clear and draw a new line curve every time the macro is run.

Sub addchart()

    If ActiveSheet.ChartObjects.Count > 0 Then
        ActiveSheet.ChartObjects.Delete
    End If
    
    Dim ws As Worksheet
    Dim ch As chart
    Dim ch1 As chart
    Dim dt As Range
     
    Dim i As Integer
    
    i = Cells(Rows.Count, "I").End(xlUp).Row
    
    Set ws = ActiveSheet
    Set dt = Range(Cells(2, 10), Cells(i, 10))
    Set ch = ws.Shapes.AddChart2(Width:=1300, Height:=300, Left:=Range("a13").Left, Top:=Range("a13").Top).chart
    
    
    With ch
        .SetSourceData Source:=dt
        .ChartTitle.Text = "Deflection Curve"
        .ChartType = xlLine
        .SeriesCollection(1).Name = "Deflection"
    End With
    
    If Application.WorksheetFunction.Min(dt) > -50 Then
    With ch.Axes(xlValue)
        .MinimumScale = -50
        .MaximumScale = 0
    End With
    End If
    
End Sub

The chart that is printed looks something like this

chart

I'm trying to figure out how to add labels to arbitrary points to the chart. Two labels to be specific. One is at the minimum value. And one is the value at any arbitrary point on x-axis. Both x-values are known and will be taken as inputs from two cells on the sheet. Something like this.

Something like this

The style of highlighting is unimportant. Thanks for the help!

P.S. - I'm new to VBA and I'm learning everything on the go. I look up what I need to do and then try and imitate whatever examples I see online. So it's possible the existing program I've written for the chart might have unnecessary steps or is inefficient in some way. I would appreciate it if someone had any tips to offer to improve it, even though it does the job. Thanks!

Upvotes: 1

Views: 867

Answers (2)

Wren
Wren

Reputation: 79

Sub addchart()

    If ActiveSheet.ChartObjects.Count > 0 Then
        ActiveSheet.ChartObjects.Delete
    End If
    
    Dim ws As Worksheet
    Dim ch As Chart
    Dim dt As Range
     
    Dim i As Integer
    
    i = Cells(Rows.Count, "I").End(xlUp).Row
    
    Set ws = ActiveSheet
    Set dt = Range(Cells(2, 10), Cells(i, 11))      ' Added another column with the relevant values to highlight line chart
    Set ch = ws.Shapes.AddChart2(Width:=1300, Height:=300, Left:=Range("a13").Left, Top:=Range("a13").Top).Chart
    
    
    With ch
        .SetSourceData Source:=dt
        .ChartTitle.Text = "Deflection Curve"
        .FullSeriesCollection(1).ChartType = xlLine
        .SeriesCollection(1).Name = "Deflection"
        .SeriesCollection(2).ChartType = xlColumnStacked       'the second column shows up as a bar chart along with the line chart
    End With
    
    If Application.WorksheetFunction.Min(Range(Cells(2, 10), Cells(i, 10))) > -30 Then
    With ch.Axes(xlValue)
        .MinimumScale = -30
        .MaximumScale = 0
    End With
    End If
    
End Sub

Upvotes: 1

Capt.Krusty
Capt.Krusty

Reputation: 627

Try those for first steps making chart labels:

Dim chartname as string

chartname = "enter_a_name"

ActiveSheet.Shapes.AddChart2(227, xlLine).Name = chartname
    With ActiveSheet.Shapes(chartname).Line
        .Visible = msoTrue
        .ForeColor.RGB = RGB(0, 0, 0)
        .Transparency = 0
        .Weight = 1.5
    End With
        
Set my_chart = ActiveSheet.ChartObjects(chartname).Chart
    
    'Delete all Autolabels
    my_chart.SetElement (msoElementDataLabelNone)
    
    'Enter format of axis (just if you want to)
    'With my_chart.Axes(xlCategory)      ' axis adjustment
        '.CategoryType = xlCategoryScale ' not XlCategoryType.xlAutomaticScale | XlCategoryType.xlTimeScale
        '.TickLabels.NumberFormat = "DD.MM.YYYY hh:mm"
        '.TickLabels.Orientation = xlUpward
    'End With
    
    cols = Array("F", "L")              ' columns containing labels
    For j = 1 To my_chart.SeriesCollection.Count
        Set sc = my_chart.SeriesCollection(j)

        For i = 2 To sc.Points.Count
            sc.Points(i).ApplyDataLabels
            sc.Points(i).DataLabel.Text = Range(cols(j - 1) & i + x).Value ' x= starting row containing values /labels
        Next i

Upvotes: 1

Related Questions