Getting Trendline formulae - results OK when stepping thru code, missing when running

thestormdragon

New Member
Joined
Jan 18, 2013
Messages
3
Hi Everyone

I've got a bit of a weird problem - I've written some code to extract a trendline formula from a newly created graph and it works perfectly if, and only if, I step through it line by line. If I run the code it will sometimes return a null string instead of the formula - this is really annoying as I need to get the trendline formula from over 200 graphs in 200 files (that bit worked out with help from these forums).

During my troubleshooting, I've simplified and simplified the code in terms of functions being called and subroutines etc but even with just the below, it's still really flakey.

What I have is:

<!-- BEGIN TEMPLATE: bbcode_code -->
Code:
Sub draw_a_graph(graph_no As Integer, chart_type As String, new_title As String, trendlines As Boolean, first_row As Integer, last_row As Integer) 
     '***** this sub-routine adds a graph to the current sheet
    On Error Goto ErrMsg 'this error handling isn't normally here, I just added it incase something odd was happening
     
     'add the chart
    With ActiveSheet.ChartObjects.Add(Left:=300, Width:=900, Top:=90 + graph_no * 250, Height:=225) 
        .Chart.ChartType = xlLine 
        .Chart.SetSourceData Source:=Range(Cells(first_row, 1), Cells(last_row, 3)) 
         
         'set the chart title
        .Chart.HasTitle = True 
        .Chart.ChartTitle.Text = new_title 
         
         'label the Y axis
        .Chart.Axes(xlValue).HasTitle = True 
        .Chart.Axes(xlValue, xlPrimary).AxisTitle.Text = "% " & chart_type & Chr(13) & "use" 
        .Chart.SetElement (msoElementPrimaryValueAxisTitleHorizontal) 
         
         'set the Y scale and format
        .Chart.Axes(xlValue, xlPrimary).MaximumScale = 100 
        .Chart.Axes(xlValue, xlPrimary).MinimumScale = 0 
        .Chart.Axes(xlValue, xlPrimary).TickLabels.NumberFormat = "0" 
         
         'label the series correctly
        .Chart.SeriesCollection(1).Name = "=""Received (%)""" 
        .Chart.SeriesCollection(2).Name = "=""Sent (%)""" 
         
         'if required, add the trendlines
        If trendlines Then 
             'add Received Trendline
            .Chart.SeriesCollection(1).trendlines.Add 
            .Chart.SeriesCollection(1).trendlines(1).Format.Line.ForeColor.ObjectThemeColor = msoThemeColorAccent1 
             
             
             'add Sent Trendline
            .Chart.SeriesCollection(2).trendlines.Add 
            .Chart.SeriesCollection(2).trendlines(1).Format.Line.ForeColor.ObjectThemeColor = msoThemeColorAccent2 
             
             'add formula for the trendline
            ActiveSheet.Range("g2") = "RX Trend =" 
            ActiveSheet.Range("g3") = "TX Trend =" 
            .Chart.SeriesCollection(1).trendlines(1).DisplayEquation = True 
            .Chart.SeriesCollection(2).trendlines(1).DisplayEquation = True 
            ActiveSheet.Range("h2").Value = .Chart.SeriesCollection(1).trendlines(1).DataLabel.Text 
            ActiveSheet.Range("h3").Value = .Chart.SeriesCollection(2).trendlines(1).DataLabel.Text 
            .Chart.SeriesCollection(1).trendlines(1).DisplayEquation = False 
            .Chart.SeriesCollection(2).trendlines(1).DisplayEquation = False 
        End If 
         
    End With 
    Exit Sub 
ErrMsg: 
    MsgBox ("Something's gone wrong somewhere") 
End Sub


<!-- END TEMPLATE: bbcode_code -->The graphs always get added, even if the formulas don't.
The headings in G2 and G3 always get added, even if the formulas don't.
I've tried outputting to a variable, instead of a cell value, and that doesn't always work.
I've tried outputting to a msgbox, instead of a cell value, and that doesn't always work.

The draw_a_graph sub-routine is called from

Code:
Sub run_VBA_code_on_all_excel_sheets_in_a_folder() 
     '*****this sub-routine will run specified code on every .XLSX file in a specified folder
    Dim wbBook As Workbook 
    Dim default_path As String 
    Dim src_file As String 
     
     '********************************* DECLARE ANY VARIABLES REQUIRED HERE ********************************
     
     
     '********************************* DECLARE ANY VARIABLES REQUIRED HERE ********************************
     
     'turn off the screen etc for quicker processing
    Application.ScreenUpdating = False 
    Application.DisplayAlerts = False 
    Application.EnableEvents = False 
     'set the default source directory
    default_path = "C:\reports\" 'trailing \ is very important
     
     'dir returns the first filname from the default path
    src_file = Dir(default_path & "*.xlsx") 
     
     'change to the source directory
    ChDir (default_path) 
     
     'loop while files to process
    Do While src_file <> vbNullString 
         'open the file
        Set wbBook = Workbooks.Open(src_file) 
         '**********************************************************
         'do whatever you want per book below here
         '**********************************************************
         
         
        Call draw_a_graph(0, "bandwidth", "Router Graph", True, 7, 372) 
         
         
        wbBook.Close savechanges:=True 'close the file, saving changes
         
         '**********************************************************
         'do whatever you want per book above here
         '**********************************************************
         
         
         'get the next filename
        src_file = Dir 
    Loop 
     'turn options back to normal
    Application.ScreenUpdating = True 
    Application.DisplayAlerts = True 
    Application.EnableEvents = True 
End Sub


<!-- BEGIN TEMPLATE: bbcode_code --><!-- END TEMPLATE: bbcode_code -->I have uploaded 5 of the files to be graphed to http://www.mi5.in/vba/reports.zip .

I'm running Excel 2010 on Windows 7.

I've searched all sorts of forums and help files and google and I just can't make heads or tails of what's happening - any thoughts gratefully accepted!

All the best

David
 

Excel Facts

Can a formula spear through sheets?
Use =SUM(January:December!E7) to sum E7 on all of the sheets from January through December
The same happens here. I expect it's to do with the code running faster than it should?!
You can get the gradient and intercept mathematically (and more accurately too); try changing the draw graph routine to:
Code:
Sub draw_a_graph(graph_no As Integer, chart_type As String, new_title As String, trendlines As Boolean, first_row As Integer, last_row As Integer)
'***** this sub-routine adds a graph to the current sheet
On Error GoTo ErrMsg 'this error handling isn't normally here, I just added it incase something odd was happening

'add the chart
With ActiveSheet.ChartObjects.Add(Left:=300, Width:=900, Top:=90 + graph_no * 250, Height:=225)
    .Chart.ChartType = xlLine
    .Chart.SetSourceData Source:=Range(Cells(first_row, 1), Cells(last_row, 3))

    'set the chart title
    .Chart.HasTitle = True
    .Chart.ChartTitle.Text = new_title

    'label the Y axis
    .Chart.Axes(xlValue).HasTitle = True
    .Chart.Axes(xlValue, xlPrimary).AxisTitle.Text = "% " & chart_type & Chr(13) & "use"
    .Chart.SetElement (msoElementPrimaryValueAxisTitleHorizontal)

    'set the Y scale and format
    .Chart.Axes(xlValue, xlPrimary).MaximumScale = 100
    .Chart.Axes(xlValue, xlPrimary).MinimumScale = 0
    .Chart.Axes(xlValue, xlPrimary).TickLabels.NumberFormat = "0"

    'label the series correctly
    .Chart.SeriesCollection(1).Name = "=""Received (%)"""
    .Chart.SeriesCollection(2).Name = "=""Sent (%)"""
    'if required, add the trendlines
    If trendlines Then
        'add Received Trendline
        .Chart.SeriesCollection(1).trendlines.Add
        .Chart.SeriesCollection(1).trendlines(1).Format.Line.ForeColor.ObjectThemeColor = msoThemeColorAccent1

        'add Sent Trendline
        .Chart.SeriesCollection(2).trendlines.Add
        .Chart.SeriesCollection(2).trendlines(1).Format.Line.ForeColor.ObjectThemeColor = msoThemeColorAccent2

        'add formula for the trendline
        ActiveSheet.Range("g2") = "RX Trend ="
        ActiveSheet.Range("g3") = "TX Trend ="
        '.Chart.SeriesCollection(1).trendlines(1).DisplayEquation = True
        '.Chart.SeriesCollection(2).trendlines(1).DisplayEquation = True
        'ActiveSheet.Range("h2").Value = .Chart.SeriesCollection(1).trendlines(1).DataLabel.Text
        'ActiveSheet.Range("h3").Value = .Chart.SeriesCollection(2).trendlines(1).DataLabel.Text
        [COLOR=#0000ff]yy = .Chart.SeriesCollection(1).Values
        xx = Evaluate("transpose(row(A1:A" & UBound(yy) & "))")
        zz = Application.WorksheetFunction.LinEst(yy, xx)
        ActiveSheet.Range("H2") = "y = " & Format(zz(1), "0.####") & "x + " & Format(zz(2), "0.####")
        yy = .Chart.SeriesCollection(2).Values
        zz = Application.WorksheetFunction.LinEst(yy, xx)
        ActiveSheet.Range("H3") = "y = " & Format(zz(1), "0.####") & "x + " & Format(zz(2), "0.####")[/COLOR]
        '.Chart.SeriesCollection(1).trendlines(1).DisplayEquation = False
        '.Chart.SeriesCollection(2).trendlines(1).DisplayEquation = False
    End If

End With
Exit Sub
ErrMsg:
MsgBox ("Something's gone wrong somewhere")
End Sub
I've highlighted new lines in blue, commented out lines no-longer needed. At the moment, using the FORMAT function, I've got it to display the same accuracy as you had, but you can miss out the format function altogether and get a more accurate gradient and intercept. There may still need to be some tweak if the intercept is a negative value to stop it displaying the likes of:
y = 0.2345x +-0.0567
and get it instead to display:
y = 0.2345x -0.0567

I'll come back with regard to this.
 
Upvote 0
I'll come back with regard to this.
Well that was easy; change the two similar lines to:
Code:
        ActiveSheet.Range("H2") = "y = " & Format(zz(1), "+ 0.####;- 0.####") & "x " & Format(zz(2), "+ 0.####;- 0.####")
        ActiveSheet.Range("H3") = "y = " & Format(zz(1), "+ 0.####;- 0.####") & "x " & Format(zz(2), "+ 0.####;- 0.####")
Change the number of #s to change accuracy.
 
Upvote 0
a better one (more like your original version's results):
Code:
ActiveSheet.Range("H2") = "y = " & Format(zz(1), "0.####") & "x " & Format(zz(2), "+ 0.####;- 0.####")
ActiveSheet.Range("H3") = "y = " & Format(zz(1), "0.####") & "x " & Format(zz(2), "+ 0.####;- 0.####")
 
Upvote 0
Thanks very much for your help.

When I try your updated solution

Code:
                          yy = .Chart.SeriesCollection(1).Values
                          xx = Evaluate("transpose(row(A1:A" & UBound(yy) & "))")
                          
                          zz = Application.WorksheetFunction.LinEst(yy, xx)
                          ActiveSheet.Range("H2") = "y = " & Format(zz(1), "0.####") & "x " & Format(zz(2), "+ 0.####;- 0.####")
                          
                          yy = .Chart.SeriesCollection(2).Values
                          zz = Application.WorksheetFunction.LinEst(yy, xx)
                          ActiveSheet.Range("H3") = "y = " & Format(zz(1), "0.####") & "x " & Format(zz(2), "+ 0.####;- 0.####")

I get "Run-time error '1004': Unable to get the LinEst property of the WorksheetFunction class" on the line

Code:
zz = Application.WorksheetFunction.LinEst(yy, xx)

At this point in time
xx is a variant (1 to 365) containing the values 1,2,3,.......,364,365
yy is a variant (1 to 365) containing the value 0,0,0,0,0 (upto 120), then Empty (121 to 365)

Any thoughts?

Thanks again

David
 
Upvote 0
Fortunately, Slope and Intercept work with blank cells so:
Code:
Sub draw_a_graph(graph_no As Integer, chart_type As String, new_title As String, trendlines As Boolean, first_row As Integer, last_row As Integer)
'***** this sub-routine adds a graph to the current sheet
'On Error GoTo ErrMsg 'this error handling isn't normally here, I just added it incase something odd was happening

'add the chart
With ActiveSheet.ChartObjects.Add(Left:=300, Width:=900, Top:=90 + graph_no * 250, Height:=225)
    .Chart.ChartType = xlLine
    .Chart.SetSourceData Source:=Range(Cells(first_row, 1), Cells(last_row, 3))

    'set the chart title
    .Chart.HasTitle = True
    .Chart.ChartTitle.Text = new_title

    'label the Y axis
    .Chart.Axes(xlValue).HasTitle = True
    .Chart.Axes(xlValue, xlPrimary).AxisTitle.Text = "% " & chart_type & Chr(13) & "use"
    .Chart.SetElement (msoElementPrimaryValueAxisTitleHorizontal)

    'set the Y scale and format
    .Chart.Axes(xlValue, xlPrimary).MaximumScale = 100
    .Chart.Axes(xlValue, xlPrimary).MinimumScale = 0
    .Chart.Axes(xlValue, xlPrimary).TickLabels.NumberFormat = "0"

    'label the series correctly
    .Chart.SeriesCollection(1).Name = "=""Received (%)"""
    .Chart.SeriesCollection(2).Name = "=""Sent (%)"""
    'if required, add the trendlines
    If trendlines Then
        'add Received Trendline
        .Chart.SeriesCollection(1).trendlines.Add
        .Chart.SeriesCollection(1).trendlines(1).Format.Line.ForeColor.ObjectThemeColor = msoThemeColorAccent1

        'add Sent Trendline
        .Chart.SeriesCollection(2).trendlines.Add
        .Chart.SeriesCollection(2).trendlines(1).Format.Line.ForeColor.ObjectThemeColor = msoThemeColorAccent2

        'add formula for the trendline
        ActiveSheet.Range("g2") = "RX Trend ="
        ActiveSheet.Range("g3") = "TX Trend ="
        yy = .Chart.SeriesCollection(1).Values
        xx = Evaluate("transpose(row(A1:A" & UBound(yy) & "))")
        zz1 = Application.WorksheetFunction.Slope(yy, xx)
        zz2 = Application.WorksheetFunction.Intercept(yy, xx)
        ActiveSheet.Range("H2") = "y = " & Format(zz1, "0.####") & "x " & Format(zz2, "+ 0.####;- 0.####")
        yy = .Chart.SeriesCollection(2).Values
        zz1 = Application.WorksheetFunction.Slope(yy, xx)
        zz2 = Application.WorksheetFunction.Intercept(yy, xx)
        ActiveSheet.Range("H3") = "y = " & Format(zz1, "0.####") & "x " & Format(zz2, "+ 0.####;- 0.####")
    End If

End With
Exit Sub
ErrMsg:
MsgBox ("Something's gone wrong somewhere")
End Sub
 
Upvote 0
Hi

Thanks for your quick reply.

If you were local to me, I'd buy you a beer for sorting this issue out for me - it's been bugging me for too long and now it's sorted.

Thanks very much again

David
 
Upvote 0

Forum statistics

Threads
1,214,429
Messages
6,119,424
Members
448,896
Latest member
MadMarty

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