I finally got this to work, sort of. For those curious about the code, it calculates least squares polynomial regression.
To get it to work, I had to do the following Change B(i) to B(1) Know that it will continue to do the the do loop. I had to set the end condition in a subroutine so when it went back it would stop. Note it finishes one more loop than needed some I am getting some garbage data but I can accept that. The initial go sub worked great but needed be pulled out of the main program. When the loop was done it launched the subroutine again. This seems to work great with integers. Real numbers may be a bit off but at least initial numbers are close to the values I had for the original test problem. Doing a check of my results showed that I solved the related problem so I accept the results. On Jul 2, 9:46 am, larry <laurence.tha...@navy.mil> wrote: > Thanks for the idea but it doesn't seem to work. I am probably messing > up the subroutine formats. I hate to post long code but here it is. > Any advice would be welcome. > > Option Explicit > Dim A(11, 12) As Variant, XX_values(11, 11) As Variant, XY_values(11) > As Variant > Dim X(200) As Variant, Y(200) As Variant, B(11) As Variant > Public Num As Integer, I As Integer, J As Integer, K_degree As > Integer, Row_Count As Integer > Public Sum_X As Double, Sum_Y As Double, Sum_XY As Double, Sum_XS As > Double > Public PM_SSQ As Double, N As Integer, M As Integer, K As Integer, > Diff As Double > Public Sum_Sq As Double, Prod As Double, Y_Hat As Double, CM_SSQ As > Double > Public Sum1 As Double, Sum2 As Double, Sum3 As Double, XK As Double > Sub LSPR() > Application.EnableEvents = False > Num = Cells(2, 2).Value > Sum_X = 0# > Sum_Y = 0# > Sum_XY = 0# > Sum_XS = 0# > Row_Count = 10 > For I = 1 To Num > X(I) = Cells(I + 1, 5).Value > Y(I) = Cells(I + 1, 6).Value > Sum_Y = Sum_Y + Y(I) > Sum_X = Sum_X + X(I) > Sum_XY = Sum_XY + X(I) * Y(I) > Sum_XS = Sum_XS + X(I) * X(I) > Next I > PM_SSQ = 1000000000# > K_degree = 1 > N = K_degree + 1 > M = N + 1 > XX_values(1, 1) = Num > XX_values(1, 2) = Sum_X > XX_values(2, 1) = Sum_X > XX_values(2, 2) = Sum_XS > XY_values(1) = Sum_Y > XY_values(2) = Sum_XY > Do Until K_degree = 10 > For I = 1 To N > For J = 1 To N > A(I, J) = XX_values(I, J) > Next J > A(I, M) = XY_values(I) > Next I > GoSub Jordan > Sum_Sq = 0# > For I = 1 To Num > Prod = 0# > For J = 1 To K_degree > Prod = Prod + A(J + 1, M) * X(I) ^ J > Next J > Y_Hat = A(1, M) + Prod > Sum_Sq = Sum_Sq + (Y(I) - Y_Hat) ^ 2 > Next I > If Num - K_degree - 1 = 0 Then Call Out_put > CM_SSQ = Sum_Sq / (Num - K_degree - 1) > If CM_SSQ >= PM_SSQ Then Call Out_put > Cells(Row_Count, 1).Value = K_degree > Cells(Row_Count, 2).Value = "Degree Polynomial Coefficients" > Row_Count = Row_Count + 1 > Cells(Row_Count, 1).Value = "Beta" > Cells(Row_Count, 3).Value = "CMSSQ" > For I = 1 To N > Row_Count = Row_Count + 1 > Cells(Row_Count, 1).Value = I - 1 > Cells(Row_Count, 2).Value = A(I, M) > Next I > Cells(Row_Count, 3).Value = CM_SSQ > Row_Count = Row_Count + 2 > PM_SSQ = CM_SSQ > K_degree = K_degree + 1 > N = K_degree + 1 > M = N + 1 > For I = 1 To K_degree - 1 > XX_values(K_degree + 1, I) = XX_values(K_degree, I + 1) > XX_values(I, K_degree + 1) = XX_values(K_degree + 1, I) > Next I > Sum1 = 0 > Sum2 = 0 > Sum3 = 0 > For I = 1 To Num > XK = X(I) ^ K_degree > Sum1 = Sum1 + XK * X(I) ^ (K_degree - 1) > Sum2 = Sum2 + XK * XK > Sum3 = Sum3 + XK * Y(I) > Next I > XX_values(K_degree + 1, K_degree) = Sum1 > XX_values(K_degree + 1, K_degree + 1) = Sum2 > XX_values(K_degree, K_degree + 1) = Sum1 > XY_values(K_degree + 1) = Sum3 > For J = 1 To K > B(J) = A(J, N) > Next J > Loop > Jordan: > For K = 1 To N > For J = (K + 1) To M > A(K, J) = A(K, J) / A(K, K) > Next J > For I = 1 To N > If I <> K Then > For J = (K + 1) To M > A(I, J) = A(I, J) - A(I, K) * A(K, J) > Next J > End If > Next I > Next K > Return > End Sub > > Sub Out_put() > Cells(1, 11).Value = K_degree - 1 > For I = 1 To Num > Prod = 0# > For J = 1 To K_degree - 1 > Prod = Prod + B(J + 1) * X(I) ^ J > Next J > Y_Hat = B(I) + Prod > Diff = Y(I) - Y_Hat > Cells(I + 1, 7).Value = Y_Hat > Cells(I + 1, 8).Value = Diff > Next I > Application.EnableEvents = True > End Sub > > On Jul 1, 10:59 pm, Dave Bonallack <davebonall...@hotmail.com> wrote: > > > > > Hi Larry, > > > Usual cause of that behaviour is other event macros. > > > Start with: Application.EnableEvents = False > > > Then your code. > > > Then at the end: Application.EnableEvents = True > > > Regards - Dave. > > > _________________________________________________________________ > > View photos of singles in your area Click > > Herehttp://dating.ninemsn.com.au/search/search.aspx?exec=go&tp=q&gc=2&tr=...- > > Hide quoted text - > > - Show quoted text - --~--~---------~--~----~------------~-------~--~----~ ---------------------------------------------------------------------------------- Some important links for excel users: 1. Excel and VBA Tutorials(Video and Text), Free add-ins downloads at http://www.excelitems.com 2. Excel tutorials at http://www.excel-macros.blogspot.com 3. Learn VBA Macros at http://www.vbamacros.blogspot.com 4. Excel Tips and Tricks at http://exceldailytip.blogspot.com To post to this group, send email to excel-macros@googlegroups.com If you find any spam message in the group, please send an email to: Ayush Jain @ jainayus...@gmail.com or Ashish Jain @ 26may.1...@gmail.com <><><><><><><><><><><><><><><><><><><><><><> HELP US GROW !! We reach over 5,000 subscribers worldwide and receive many nice notes about the learning and support from the group. Our goal is to have 10,000 subscribers by the end of 2009. Let friends and co-workers know they can subscribe to group at http://groups.google.com/group/excel-macros/subscribe -~----------~----~----~----~------~----~------~--~---
