Attribute VB_Name = "Module1" Function Trendy(ByVal XVal As Double, Optional ChtNo As Integer, Optional SeriesNo As Integer, Optional TrendNo As Integer) As Variant ' ' TrendY ' A UDF to return a Y Value from a Charts Trendline equation ' ' Written by Ian Huitson ' Sept 2010 ' Updated Jan 2011 ' Published at Chandoo.org/wp ' ' Code improvements by Daniel Ferry ' http://www.excelhero.com/blogs/ ' Thanx Daniel ' Dim m As Double, a As Double, b As Double, c As Double Dim num As Double, tval As Double, movav As Double Dim myTrend As String Dim lngPtr As Long Dim DL As Boolean Const F = 5 'Formula Start position in strings Const EXPO = 5 Const LINEAR = -4132 Const LOGO = -4133 Const POLYNOMIAL = 3 Const POWER = 4 Const DataLabelNoFormat = "#,##0.0000" Const PolynomialNoFormat = "#,##0.000000000000" 'If you get inaccuracies with the plotted values for Polynomial Charts increase the number of 0's after the decimal DL = False If ChtNo = 0 Then ChtNo = 1 If SeriesNo = 0 Then SeriesNo = 1 If TrendNo = 0 Then TrendNo = 1 DoEvents DoEvents With ActiveSheet.ChartObjects(ChtNo).Chart.SeriesCollection(SeriesNo).Trendlines(TrendNo) .DisplayEquation = True If .DisplayRSquared = True Then .DisplayRSquared = False 'remove r^2 parameter DoEvents DL = True End If .DataLabel.NumberFormat = DataLabelNoFormat myTrend = .DataLabel.Text 'This is the Equation of the Trendline myTrend = Trim(myTrend) If DL = True Then .DisplayRSquared = True If .Type = EXPO Then 'eg: y = 66.983e0.0107x lngPtr = InStr(F, myTrend, "e") a = Mid(myTrend, F, lngPtr - F) b = Mid(myTrend, lngPtr + 1, Len(myTrend) - lngPtr - 1) Trendy = a * Exp(b * XVal) ElseIf .Type = LINEAR Then 'eg: y = 1.0562x + 66.273 lngPtr = InStr(F, myTrend, "x") m = Mid(myTrend, F, lngPtr - F) c = Right(myTrend, Len(myTrend) - lngPtr - 2) Trendy = XVal * m + c ElseIf .Type = LOGO Then 'eg: y = 14.195ln(x) + 48.775 a = Mid(myTrend, F, InStr(F, myTrend, "ln") - F) b = Right(myTrend, Len(myTrend) - InStr(F, myTrend, " + ") - 2) Trendy = a * Log(XVal) + b ElseIf .Type = POLYNOMIAL Then 'eg: y = -0.0534x2 + 3.2448x + 50.953 'with up to power 6 'y = 5E-07x6 - 1E-05x5 - 0.0016x4 + 0.0792x3 - 1.1071x2 + 5.4142x + 61.542 polyorder = .Order 'Increase decimals to improve accuracy .DataLabel.NumberFormat = PolynomialNoFormat DoEvents 'Updates Equation Textbox on screen 'Hide R^2 if shown If .DisplayRSquared = True Then .DisplayRSquared = False 'remove r^2 parameter DoEvents DL = True End If 'get formula for Polynomial equation myTrend = .DataLabel.Text 'reset r^2 if required If DL = True Then .DisplayRSquared = True 'Reset decimals for Display .DataLabel.NumberFormat = DataLabelNoFormat DoEvents tval = 0 'temporary counter If InStr(1, myTrend, "x6") > 0 Then lngPtr = InStr(1, myTrend, "=") num = Mid(myTrend, lngPtr + 1, InStr(1, myTrend, "x6") - lngPtr - 1) tval = tval + num * (XVal ^ 6) End If If InStr(1, myTrend, "x5") > 0 Then If polyorder = 5 Then lngPtr = InStr(1, myTrend, "=") num = Mid(myTrend, lngPtr + 1, InStr(1, myTrend, "x5") - lngPtr - 1) Else lngPtr = InStr(1, myTrend, "x6") num = Mid(myTrend, lngPtr + 2, InStr(1, myTrend, "x5") - lngPtr - 2) End If tval = tval + num * (XVal ^ 5) End If If InStr(1, myTrend, "x4") > 0 Then If polyorder = 4 Then lngPtr = InStr(1, myTrend, "=") num = Mid(myTrend, lngPtr + 1, InStr(1, myTrend, "x4") - lngPtr - 1) Else lngPtr = InStr(1, myTrend, "x5") num = Mid(myTrend, lngPtr + 2, InStr(1, myTrend, "x4") - lngPtr - 2) End If tval = tval + num * (XVal ^ 4) End If If InStr(1, myTrend, "x3") > 0 Then If polyorder = 3 Then lngPtr = InStr(1, myTrend, "=") num = Mid(myTrend, lngPtr + 1, InStr(1, myTrend, "x3") - lngPtr - 1) Else lngPtr = InStr(1, myTrend, "x4") num = Mid(myTrend, lngPtr + 2, InStr(1, myTrend, "x3") - lngPtr - 2) End If tval = tval + num * (XVal ^ 3) End If If InStr(1, myTrend, "x2") > 0 Then If polyorder = 2 Then lngPtr = InStr(1, myTrend, "=") num = Mid(myTrend, lngPtr + 1, InStr(1, myTrend, "x2") - lngPtr - 1) Else lngPtr = InStr(1, myTrend, "x3") num = Mid(myTrend, lngPtr + 2, InStr(1, myTrend, "x2") - lngPtr - 2) End If tval = tval + num * (XVal ^ 2) End If If InStr(1, myTrend, "x + ") > 0 Then lngPtr = InStr(1, myTrend, "x2") num = Mid(myTrend, lngPtr + 2, InStr(1, myTrend, "x + ") - lngPtr - 2) tval = tval + num * XVal tval = tval + Right(myTrend, Len(myTrend) - InStr(1, myTrend, "x + ")) End If If InStr(1, myTrend, "x - ") > 0 Then lngPtr = InStr(1, myTrend, "x - ") num = Mid(myTrend, InStr(1, myTrend, "x2") + 2, lngPtr - InStr(1, myTrend, "x2") - 2) tval = tval + num * XVal tval = tval + Right(myTrend, Len(myTrend) - lngPtr) End If Trendy = tval ElseIf .Type = POWER Then 'y = 55.426x0.1479 lngPtr = InStr(F, myTrend, "x") a = Mid(myTrend, F, lngPtr - F) b = Right(myTrend, Len(myTrend) - lngPtr) Trendy = a * (XVal ^ b) Else Trendy = "Moving Average not supported" End If End With End Function