XY Scatter plot has formulae and legend issues.

sts023

Board Regular
Joined
Sep 1, 2008
Messages
106
Hi Guys....

I'm still trying to get a chart working, in terms of extracting the formula for a trend line.

I have now got two distinct problems - the formula isn't being extracted, and the dates along the horizontal axis aren't fully visible.
Also, if you access the spreadsheet (I've put it on Dropbox and attached a link), if you delete the data below row 20, the VBA complaines about the Chart's Title!

I must have looked at dozens of posts in an attempt to achieve a simple goal, but there seems to be a myriad of ways to create a chart using VBA.

Having accepted that in order to get an accurate formula I need to use an XY Scatter plot, I now find I can't get at the formula unless I step through the code. If I do that, it works perfectly.
I've tried putting various waits, loops and delays in the code to "simulate" stepping through, but nothing works.

Please, can anyone offer any help?

The Dropbox URL is

https://www.dropbox.com/s/tg9xqr2q8s1w37t/TestBed.xlsm?dl=0
 

Excel Facts

Which Excel functions can ignore hidden rows?
The SUBTOTAL and AGGREGATE functions ignore hidden rows. AGGREGATE can also exclude error cells and more.
Sorry, VBA follows:-
Code:
Sub SampleChart()
Dim chtChart                As Chart
Dim lngEndRow               As Long
Dim objChart                As ChartObject
Dim rngDataSource           As Range
Dim rngPosition             As Range
Dim srsNew                  As Series
Dim strTLEL                 As String
Dim strTLEP6                As String
Dim wks                     As Worksheet
'*
'** Set Worksheet.
'*
  Set wks = Worksheets("SampleData")
  lngEndRow = wks.Cells(wks.Rows.Count, _
                        "B").End(xlUp).Row
'*
'** Set range to cover the data.
'*
  Set rngDataSource = wks.Range("B3:C" & CStr(lngEndRow))
'*
'** Set the Chart's eventual placement.
'*
  Set rngPosition = wks.Range("D3:L20")
'*
'** Remove any previous charts during testing.
'*
  For Each objChart In wks.ChartObjects
    objChart.Delete
  Next objChart
'*
'** Create the chart in the
'** predetermined position.
'*
  Set chtChart = wks.ChartObjects. _
      Add(Left:=rngPosition.Left, _
          Width:=rngPosition.Width, _
          Top:=rngPosition.Top, _
          Height:=rngPosition.Height).Chart
'*
'** Set up the basics.
'*
  With chtChart
    .HasTitle = True
    .ChartTitle.Text = "Balances"
    .ChartType = xlXYScatterSmoothNoMarkers
'*
'** Add the single series.
'*
    Set srsNew = .SeriesCollection.NewSeries
'*
'** Set the name and values for the series.
'*
    With srsNew
      .Name = "Vals"
      .XValues = rngDataSource.Columns(1)
      .Values = rngDataSource.Columns(2)
'*
'** Add and name a black continuous
'** Linear trendline.
'*
      .Trendlines.Add
      With .Trendlines(1)
        .Name = "T (L)"
        .Type = xlLinear
        With .Border
          .ColorIndex = 1
          .Weight = 1.25
          .LineStyle = xlContinuous
        End With
      End With
'*
'** Add and name a red continuous
'** Polynomial order 6 trendline.
'*
      .Trendlines.Add
      With .Trendlines(2)
        .Name = "T (P6)"
        .Type = xlPolynomial
        .Order = 6
        With .Border
          .ColorIndex = 3
          .Weight = 1.25
          .LineStyle = xlContinuous
        End With
      End With
    End With
'*
'** Reformat the horizontal (date) axis
'*  to show in weeks, and to set the
'** font and text orientation.
'*
    With .Axes(xlCategory)
      .Format.Line.Weight = 1.5
      .MajorUnit = 7
      With .TickLabels
        .Orientation = xlTickLabelOrientationDownward
        .AutoScaleFont = False
        With .Font
          .Name = "Calibri"
          .FontStyle = "Regular"
          .Size = 6
        End With
      End With
    End With
  End With
'*
'** Now recover the equation from
'** the Linear trendline.
'*
  strTLEL = funTrendlineEquation(srsNew.Trendlines(1))
  Call MsgBox(strTLEL)
End Sub
Function funTrendlineEquation(tlnTrend As Trendline) As String
Dim booOrigE                As Boolean
Dim booOrigR2               As Boolean
'*
'** Save the original settings, then
'** ensure that just the Linear
'** equation is displayed.
'*
  booOrigR2 = tlnTrend.DisplayRSquared
  booOrigE = tlnTrend.DisplayEquation


  tlnTrend.DisplayEquation = True
  tlnTrend.DisplayRSquared = False
'*
'** Recover the equation
'*
  funTrendlineEquation = tlnTrend.DataLabel.Text
'*
'** Restore original state
'*
  tlnTrend.DisplayRSquared = booOrigR2
  tlnTrend.DisplayEquation = booOrigE
End Function 'funTrendlineEquation
 
Upvote 0

Forum statistics

Threads
1,216,086
Messages
6,128,736
Members
449,466
Latest member
Peter Juhnke

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top