Simpson's Rule

I wrote a VBA function to implement Simpson's rule.
This finds the area under a curve

between two points without evaluating an integral analyticaly. A couple people have posted
messages on this bulletin board asking how to do that so, here's my solution:
Function Simpson(a As Double, b As Double, n As Integer) As Double
'This function calculates the area under the curve y(x) from
'x=a to x=b using Simpson's rule with n intervals
'Note: n must be even
'
'Local variables
Dim h As Double, sum As Double, term As Double
Dim x As Double
Dim i As Integer
'Do error checking
If n = 0 Or n Mod 2 = 1 Then
Simpson = 0#
MsgBox "Sorry # of intervals has to be > 0 and even"
Exit Function
End If
h = (b - a) / n
x=a
sum = 0#
For i = 1 To n Step 2
term = y(x) + 4 * y(x + h) + y(x + 2 * h)
sum = sum + term
x=x+2*h
Next i
Simpson = sum * h / 3
End Function
Function y(x)
'This function computes the pdf of the standard normal
'distribution at x.
y = Application.NormDist(x, 0, 1, False)
End Function
With n = 10, Simpson gives the same answer as Excel's normdist function so, I think my
code works. Try it! Any comments are welcome.
Thanks,
- Tom Wellington
PS I created the Simpson function by "jazzing up" the Integral function on page 195 of
Bernard Liengme's book (see reference below). Thanks to professor Liengme for letting me
post my modification here.
Reference: Bernard V. Liengme, A Guide to Microsoft Excel for Scientists and Engineers. 2nd
Edition, 2000. Woborn, MA
'Declaring the necessary variables.

Dim i
As Long
Dim TheStep
As Double
Dim Cumulative As Double

'Check if the NumberOfIntervals is a valid number.
If NumberOfIntervals < 1 Then
SimpsonIntegral = "The number of intervals must be > 0!"
Exit Function
End If
On Error GoTo ErrorHandler
'Check if the initial and final value of xi are different.
If Xstart = Xend Then
SimpsonIntegral = "Xstart must be different than Xend!"
Exit Function
End If
'Make the NumberOfIntervals even number.
NumberOfIntervals = 2 * NumberOfIntervals
'Calculating the step value.
TheStep = (Xend - Xstart) / NumberOfIntervals
'Calculating the initial value for Xstart.
Cumulative = FunctionResult(InputFunction, Xstart)
'Loop for odd values.
For i = 1 To NumberOfIntervals - 1 Step 2
Cumulative = Cumulative + 4 * FunctionResult(InputFunction, Xstart + i * TheStep)
Next i
'Loop for even values.
For i = 2 To NumberOfIntervals - 2 Step 2
Cumulative = Cumulative + 2 * FunctionResult(InputFunction, Xstart + i * TheStep)
Next i
'Calculating the final value for Xend.
Cumulative = Cumulative + FunctionResult(InputFunction, Xend)
'Finally, return the result of integration.

SimpsonIntegral = Cumulative * TheStep / 3
Exit Function
'In case of an error show an appropriate message.
ErrorHandler:
SimpsonIntegral = "Unable to calculate the integral of " & InputFunction & "!"
Exit Function
End Function
Private Function FunctionResult(MyFunction As String, x As Double) As Double
'Evaluates a given expression (as a function of xi) for a given xi value.
'Example: FunctionResult("5*xi + 3", 2) returns 5*2 + 3 = 13
'By Christos Samaras
'Date: 23/6/2013
'http://www.myengineeringworld.net
FunctionResult = Evaluate(WorksheetFunction.Substitute(MyFunction, "xi", x))
End Function
Sub Simpson()
Sheets("Sheet3").Select
Dim integral As Double, delta As Double, start As Double, last As Double
Dim n As Integer
start = 0
n = 20
last = 1
delta = (last - start) / n
integral = 0
For i = 1 To n / 2
integral = integral + (delta / 3) * (fval(start + (2 * i - 2) * delta) + 4 * fval(start + (2 * i - 1) * delta) + fval(start
+ 2 * i * delta))
Next
Cells(1, 1) = integral
End Sub
In Excel, custom name a few cells. aval, bval, cval, inthigh, intlow, nval. This will stand for
a, b, c, integral high value, integral low value, and integer n value. Now, in VB, do the
following:
Dim a, b, c, ihigh, ilow, simp1, fa, fb, simp2, adb, simpson, As Double
Dim n as Integer
' Validate user input
' Inputs
a = Range("aval").Value
b = Range("bval").Value
c = Range("cval").Value
ihigh = Range("inthigh").Value
ilow = Range("intlow").Value
n = Range("nval").Value
If Len(a) = 0 Or Len(b) = 0 Or Len(c) = 0 Or Len(ihigh) = 0 Or Len(ilow) = 0 Or Len(n) = 0
Then
' Alert user that entries have not been filled out
MsgBox "You need to enter input values before continuing.", vbExclamation, "Warning
Message"
Exit Sub
End If
simp1 = (b-a)/6
fa = (a * aval^2) + (b * aval) + c
adb = (a + b)/2
simp2 = 4 * ((a * adb^2) + (b * adb) + c)
fb = (a * bval^2) + (b * bval) + c
' Calculate Simpson value
simpson = simp1*(fa + simp2 + fb)

Simpson's Rule

Uploaded by

Copyright:

Available Formats

Simpson's Rule

Uploaded by

Document Information

Original Description:

Copyright

Available Formats

Share this document

Share or Embed Document

Sharing Options

Did you find this document useful?

Is this content inappropriate?

Copyright:

Available Formats

Simpson's Rule

Uploaded by

Copyright:

Available Formats

I wrote a VBA function to implement Simpson's rule.

This finds the area under a curve

'Declaring the necessary variables.

Dim Cumulative As Double

'Finally, return the result of integration.

You might also like