My RootCheck2 is designed to check if it is in fact a root or instead a vertical asymptote. It seems to be ignoring that second condition as the code is currently outputting both asymptotes and roots. The Oldx that the code outputs gives an fOldx greater than 5, leading me to believe that it's ignoring the second condition. Please let me know if I'm missing anything, thank you
Public Function SearchPsi(ByVal Variables As Range, ByVal x As Double) As Double
Dim Oldx As Double
Dim Checkx As Double
Dim fx As Double
Dim fOldx As Double
Dim fCheckx As Double
Dim RootCheck1 As Boolean
Dim RootCheck2 As Boolean
Do
Oldx = x
x = Oldx + 0.1
Checkx = Oldx + 0.01
fx = PSI(Variables, x)
fOldx = PSI(Variables, Oldx)
fCheckx = PSI(Variables, Checkx)
If (fx * fOldx) < 0 Then
RootCheck1 = True
End If
If Abs(fOldx) < 5 Then
RootCheck2 = True
End If
Loop Until RootCheck1 = True And RootCheck2 = True
SearchPsi = Oldx
End Function
Do
Oldx = x
x = Oldx + 0.1
Checkx = Oldx + 0.01
fx = PSI(Variables, x)
fOldx = PSI(Variables, Oldx)
fCheckx = PSI(Variables, Checkx)
Loop Until (fx * fOldx) < 0 And Abs(fOldx) < 5
Related
I am trying to create a VBA code in Excel to run integral function using Trapezoidal Rule. When I enter "INTEG("x^2+3*x+ln(x)",1,9)" in Excel formula it gives me an error. Could you please suggest how I could improve my code (see below). Thank you so much!
Function INTEG(exp As String, min As Double, max As Double)
Dim t As Double
Dim x As Integer
Dim range As Double
Dim exparray(5000) As Double
Dim dx As Double
range = max - min
dx = range / 5000
t = min
x = 0
Do Until x = 5000
exparray(x) = Evaluate(Replace(exp, "x", CStr(t))) * dx + 0.5 * dx * Abs(Evaluate(Replace(exp, "x", CStr(t + dx))) - Evaluate(Replace(exp, "x", CStr(t))))
t = t + dx
x = x + 1
Loop
INTEG = WorksheetFunction.sum(exparray)
End Function
I am trying to convert a Mathcad calculation to excel spreadsheet. I am trying to find a variable called kw. I am getting type mismatch error in the line:
INTEG = INTEG + ...
Would someone know why I am getting this error ? I have already spent a lots of time on it but couldn't find the reason. As this work is really important to me, I would like to thank in advance any help/suggestion on it.#
Option Explicit
Dim wp As Double, alpha As Double, w As Double, gama As Double, d As Double
Dim kw As Double, n As Integer, sExp As String, g As Double
'Calculating kw
Sub CalculateKw()
Dim l As Integer
alpha = ThisWorkbook.Sheets("Current-Wave Calculation").Range("H49").Value
gama = ThisWorkbook.Sheets("Current-Wave Calculation").Range("H34").Value
d = ThisWorkbook.Sheets("Environmental Data Input").Range("H4").Value
wp = ThisWorkbook.Sheets("Current-Wave Calculation").Range("H47").Value
kw = 100
For l = 1 To 99
If Err.Number = 0 Then
kw = INTEG(0, kw, 5000)
Else
kw = kw - 1
End If
Next l
ThisWorkbook.Sheets("Sheet1").Range("B1").Value = kw
End Sub
'DEFINITE INTEGRAL from 0 to kw*wp to solve JONSWAP Equation
Function INTEG(n, kw, lBit As Long)
Dim SpectralWidthParameter As Double, dMin As Double, dMax As Double
Dim dW As Double, lW As Long, AAA As String
g = 9.80665
alpha = ThisWorkbook.Sheets("Current-Wave Calculation").Range("H49").Value
gama = ThisWorkbook.Sheets("Current-Wave Calculation").Range("H34").Value
d = ThisWorkbook.Sheets("Environmental Data Input").Range("H4").Value
wp = ThisWorkbook.Sheets("Current-Wave Calculation").Range("H47").Value
dMin = 0
dMax = kw * wp
If w <= wp Then
SpectralWidthParameter = 0.07
Else
SpectralWidthParameter = 0.09
End If
sExp = "(w ^ n) * (((w / _
(Application.WorksheetFunction.Sinh(WaveNumber(0,20,w,d) * d))) ^ 2)*
(alpha * (g ^ 2) * (w ^ (-5)) * (EXP((-5 / 4) * ((w / wp) ^ (-4)))) *
(gama ^ (EXP(-0.5 * (((w - wp) / (SpectralWidthParameter * wp)) ^ 2))))))"
sExp = Replace(sExp, "EXP", "AAA")
dW = (dMax - dMin) / lBit
For lW = 1 To lBit
*INTEG = INTEG + Evaluate(Replace(Replace(sExp, "w", dMin), "AAA", _
"EXP")) * dW + 0.5 * dW * Abs(Evaluate(Replace(Replace(sExp, "w", dMin _
+dW), "AAA", "EXP")) - Evaluate(Replace(Replace(sExp, "w", dMin), _
"AAA", "EXP")))*
dMin = dMin + dW
Next lW
End Function
'BISECTION METHOD TO CALCULATE Wave number k
Function WaveNumber(a, b, w, d)
Dim klow As Double, khigh As Double, kmid As Double, i As Integer
Dim a As Integer, b As Integer
klow = a
khigh = b
kmid = (klow + khigh) / 2
For i = 1 To 100
If SolveFunction(klow, w, d) * SolveFunction(kmid, w, d) < 0 Then
khigh = kmid
kmid = (klow + khigh) / 2
Else
klow = kmid
kmid = (klow + khigh) / 2
End If
Next i
WaveNumber = kmid
End Function
'HELPER FUNCTION(Wave Dispersion Equation)FOR BISECTION METHOD
Function SolveFunction(k, w, d)
SolveFunction = k * Application.WorksheetFunction.Tanh(k * d) - (w ^ 2) _
/ 9.80665
End Function
INTEG = INTEG + Evaluate(....)
"Type mismatch" because your Evaluate expression returned an error. Adding a number to an error variant generates that runtime error.
Basically you shouldn't insert Application.WorksheetFunction.Sinh(...) in the evaluated expression, but just Sinh(...).
Moreover I think that you can re-write your code without using Evaluate, this will make debugging your code easier.
I have the following piece for code to simulate stock prices using stochastic process
Function varswap1(s0, r0, sigma0, t) As Double
Rnd (-10)
Randomize (999)
Dim i As Integer, j As Integer, r As Double
Dim stock() As Double, dt As Double
Dim per As Integer
per = WorksheetFunction.Round(t * 252, 0)
ReDim stock(per)
stock(1) = s0
dt = 1 / 252
For i = 1 To per
stock(i + 1) = stock(i) * Exp((r0 - 0.5 * sigma0 ^ 2) * dt + sigma0 * Sqr(dt) * WorksheetFunction.NormSInv(Rnd()))
Next
varswap1 = WorksheetFunction.Average(stock)
End Function
In this code, I ran debugging by placing a break point at Next and the entire For loop is working absolutely fine. The problem is after completing the loop the function exits and #VALUE! error is displayed in the cell.
I am not able to figure out what is wrong with this code.
Will be thankful if anyone can help me with it.
Try this:
Const n As Integer = 252
Function varswap1(s0, r0, sigma0, t) As Double
Rnd (-10)
Randomize (999)
Dim i As Integer, j As Integer, r As Double
Dim stock() As Double, dt As Double
Dim per As Integer
per = WorksheetFunction.Round(t * n, 0)
ReDim stock(per)
stock(0) = s0 ' First item in the array has index 0
dt = 1# / n ' Avoid integer division, 1/252 = 0
For i = 1 To per
'Each stock depends on the previous stock value:
stock(i) = stock(i - 1) * Exp((r0 - 0.5 * sigma0 ^ 2) * dt + sigma0 * Sqr(dt) * WorksheetFunction.NormSInv(Rnd()))
Next
varswap1 = WorksheetFunction.Average(stock)
End Function
I saw two issues and one suggestion.
One is the array stock goes from 0..252 but you assign values to 1..253 so it crashes.
Also there is a possible integer division resulting in dt=0.0. I updated the definition to make the intent clear that the division is to be done after the conversion from integer to double. Lastly, I moved the magic number 252 to a constant.
I am trying to run this code to calculate Q(n) at different Tn in the Equation 16.4 in the attached picture.But its not giving me the correct output. I would appreciate any help. Note: delta1=delta2 =...deltan = dt=1 ( I have taken here ) and further divided S term by 10000 just because in the Equation it is in basis point i.e. 100th part of 1 %.
Function Bootstrap(S As Range, Z As Range, L As Double) As Double
Dim j As Integer
Dim a As Variant
Dim b As Variant
Dim n As Integer
Dim Q() As Double
Dim sum As Double
Dim P As Double
Dim dt As Double
n = Application.WorksheetFunction.Max(S.Columns.Count, Z.Columns.Count)
a = S.Value
b = Z.Value
dt = 1
sum = 0
ReDim Q(0 To n)
Q(0) = 1
For j = 1 To n - 1
P = (b(1, j) * (L * Q(j - 1) - (L + dt * a(1, n) / 10000) * Q(j))) / (b(1, n) * (L + a(1, n) * dt / 10000)) + Q(n - 1) * L / (L + a(1, n) * dt / 10000)
sum = sum + P
Q(n) = sum
Next j
Bootstrap = sum
End Function
To solve a recursive function you can write it this way, for example
Function Factorial(n as long) as long
If n = 1 Then
Factorial = 1
Else
Factorial = n * Factorial(n-1)
End If
End function
Yes, you can see For...Loop can also do the Factorial calculation, but in your case, its much easier to use recursive solution.
Besides Eq 16.4 is intentionally written as a recursive function. It is not written as a summation function because it is harder to do so. If given to you is a summation function, then you can apply the For...Loop solution.
Hope this helps.
EDIT
Function Q(n as long) as double
If n = 1 Then
Q = 5
Else
Q = Z * ( L * Q_t - (L + d * S) * Q(n-1) ) / ( Z * ( L + d * S ) )
End If
End Function
Notice that the function Q keep calling itself in Q(n-1) when n>1. That is called recursive solution.
(Check the formula. I might copy it wrong)
Im Making a VBA function to calculate an integral using the trapezoidal rule
but how can I apply a function that I created in VBA to Use in a another Function...heres My Code ( the worksheet.function did not work)
Option Explicit
Function funcion(x As Double) As Double
funcion = 3 * (x ^ 3) + 5 * (x ^ 2) - 10 * x + 20
End Function
Function Sumatoria(a As Double, n As Double, h As Double) As Double
Dim i As Integer
Dim sum As Double
i = 0
sum = 0
Do While (i <= n - 1)
sum = sum + WorksheetFunction.funcion(a + i * h)
i = i + 1
Loop
Sumatoria = sum
End Function
This works :
Function Sumatoria(a As Double, n As Double, h As Double) As Double
Dim i As Integer
Dim sum As Double
Dim temp As Double
i = 0
sum = 0
Do While (i <= n - 1)
temp = a + i * h
sum = sum + funcion(temp)
i = i + 1
Loop
Sumatoria = sum
End Function