ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   VBA code to perform summation and product summation (https://www.excelbanter.com/excel-programming/298478-vba-code-perform-summation-product-summation.html)

21MSU[_2_]

VBA code to perform summation and product summation
 
I am in the process of writing VBA code to perform Lagrang
interpolation and I am not sure how to write the code for the Lagrang
polynomial function. This function is in the attachment labele
"LIP.xls". The problem is that this function involves a summation an
a product summation and I am not sure how to handle this in VBA code.
My spreadsheet is attached as "exp.xls". In this spreadsheet, the use
may input as many data points (x and y values) as they wish. Then the
can input an x value and the macro should calculate the interpolated
value.

For the values currently in the spreadsheet (x = 3);
y = 493.84

NOTE: Even though the spreadsheet currently contains only three dat
points, the user may input as many data points as they wish.

The excel spreadsheet attached gives an example of how the Lagrang
polynomial should be calculated for the values currently in th
spreadsheet.

Here is the code I have written so far

Private Sub Worksheet_Change(ByVal Target As Range)

Dim xn, yn, x
If Target.Address = "$D$5" Then

xn = Application.WorksheetFunction.CountA(Columns("A:A" )) - 3
yn = Application.WorksheetFunction.CountA(Columns("B:B" )) - 1

If xn < yn Then
MsgBox ("There must be the same number of x's as y's"), , "Hold Up!"
Exit Sub
End If

x = Range("D5").Value

????????????What should go here?????????????

End If

End Sub

How may I write a VBA macro to perform this task?

Please Help!
Thanks

Attachment filename: lip.xls
Download attachment: http://www.excelforum.com/attachment.php?postid=54635
--
Message posted from http://www.ExcelForum.com


21MSU[_3_]

VBA code to perform summation and product summation
 
Here is my spreadsheet

Attachment filename: exp.xls
Download attachment: http://www.excelforum.com/attachment.php?postid=54635
--
Message posted from http://www.ExcelForum.com


No Name

VBA code to perform summation and product summation
 
Here's a shot at it. Good Luck!

John


Sub Macro1()
Dim xcount As Integer
Dim ycount As Integer
nxcount = Range("e3").Value
nycount = Range("f3").Value
If nxcount < nycount Then GoTo theend
Dim y(1000) As Variant
Dim x(1000) As Variant
Dim xnum(1000) As Variant
Dim xden(1000) As Variant
Dim P As Variant
Dim Knownx As Variant
'
' Read Data in
' X Data in column B, starting in row 5
' Y Data in column C, starting in row 5
' Known x in range named "Known_x"
Knownx = Range("known_x").Value
For j = 1 To nxcount
x(j) = Cells(j + 4, 2).Value
y(j) = Cells(j + 4, 3).Value
Next j
For j = 1 To nxcount
xnum(j) = 1
xden(j) = 1
For k = 1 To nxcount
If k = j Then k = k + 1
If k nxcount Then GoTo skip
xnum(j) = xnum(j) * (Knownx - x(k))
xden(j) = xden(j) * (x(j) - x(k))
Next k
skip:
Next j
'
P = 0
For j = 1 To nxcount
P = P + y(j) * xnum(j) / xden(j)
Next j
'Output Result to Cell H5
Cells(5, 8).Value = P
GoTo Done
theend:
MsgBox ("There must be the same number of x's as
y's"), , "Hold Up!"
Done:
End Sub

-----Original Message-----
Here is my spreadsheet!

Attachment filename:

exp.xls
Download attachment:

http://www.excelforum.com/attachment.php?postid=546352
---
Message posted from http://www.ExcelForum.com/

.


No Name

VBA code to perform summation and product summation
 
There is a typo below = all of the "xcounts" and "ycounts"
should be "nxcount and xycount - sorry about that.

Also, if it isnt clear range e3 and f3 referred to are
counts of the x and y data.

John


-----Original Message-----
Here's a shot at it. Good Luck!

John


Sub Macro1()
Dim xcount As Integer
Dim ycount As Integer
nxcount = Range("e3").Value
nycount = Range("f3").Value
If nxcount < nycount Then GoTo theend
Dim y(1000) As Variant
Dim x(1000) As Variant
Dim xnum(1000) As Variant
Dim xden(1000) As Variant
Dim P As Variant
Dim Knownx As Variant
'
' Read Data in
' X Data in column B, starting in row 5
' Y Data in column C, starting in row 5
' Known x in range named "Known_x"
Knownx = Range("known_x").Value
For j = 1 To nxcount
x(j) = Cells(j + 4, 2).Value
y(j) = Cells(j + 4, 3).Value
Next j
For j = 1 To nxcount
xnum(j) = 1
xden(j) = 1
For k = 1 To nxcount
If k = j Then k = k + 1
If k nxcount Then GoTo skip
xnum(j) = xnum(j) * (Knownx - x(k))
xden(j) = xden(j) * (x(j) - x(k))
Next k
skip:
Next j
'
P = 0
For j = 1 To nxcount
P = P + y(j) * xnum(j) / xden(j)
Next j
'Output Result to Cell H5
Cells(5, 8).Value = P
GoTo Done
theend:
MsgBox ("There must be the same number of x's as
y's"), , "Hold Up!"
Done:
End Sub

-----Original Message-----
Here is my spreadsheet!

Attachment filename:

exp.xls
Download attachment:

http://www.excelforum.com/attachment.php?postid=546352
---
Message posted from http://www.ExcelForum.com/

.

.


21MSU[_4_]

VBA code to perform summation and product summation
 
Thanks for the code, John! It works perfectly! Much appreciated

--
Message posted from http://www.ExcelForum.com



All times are GMT +1. The time now is 01:36 AM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
ExcelBanter.com