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=...
--~--~---------~--~----~------------~-------~--~----~
-------------------------------------------------------------------------------------
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
-------------------------------------------------------------------------------------
-~----------~----~----~----~------~----~------~--~---
