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
Related
When doing a simple division problem with some defined variables I am getting the #value error in a UDF. The variables are all defined as doubles.
Apologies in advance as I am a mechanical engineer by trade so my coding is very amateur. I have a design book I use in excel that can end up being many columns long so to avoid this I am trying to code some UDFs to eliminate the all the cells just doing calculations for other cells. With that, I have run into an issue that I have in my calculations as soon as I start to try to divide variables.
In the code, I am not getting an issue until the Cx dim. I noted out everything starting at SFA_Radians and set the function to output each variable. All is good and expected values until reaching Cx. No matter what I do it seems if I am dividing by a variable I get the #VALUE error. Any help is much appreciated.
Function RADEFFECTSF(SFA As Range, FacetAngle As Range, FacetRadius As Range) As Variant
Dim Slope1 As Double
Dim Slope2 As Double
Dim X1 As Double
Dim Y1 As Double
Dim X2 As Double
Dim Y2 As Double
Dim b1 As Double
Dim b2 As Double
Dim SFA_Radians As Double
Dim FacetAngle_Radians As Double
Dim Pi As Double
Dim Cx As Double
Dim Cy As Double
Dim CalcArray() As Double
Dim i As Long
Pi = Application.WorksheetFunction.Pi()
ReDim CalcArray(1 To SFA.Cells.Count)
For i = 1 To SFA.Cells.Count
SFA_Radians = SFA(i) * Pi / 180
FacetAngle_Radians = FacetAngle(i) * Pi / 180
Slope1 = -Tan(SFA_Radians)
Slope2 = Tan(FacetAngle_Radians)
X1 = FacetRadius(i) * Sin(SFA_Radians)
Y1 = FacetRadius(i) * Cos(SFA_Radians)
b1 = Y1 - (Slope1 * X1)
X2 = -FacetRadius(i) * Sin(FacetAngle_Radians)
Y2 = FacetRadius(i) * Cos(FacetAngle_Radians)
b2 = Y2 - (Slope2 * X2)
Cx = (b2 - b1) / (Slope1 - Slope2)
Cy = (Slope1 * (Cx / (b1))) + b1
CalcArray(i) = Cy - (FacetRadius(i) * Cos(SFA_Radians))
Next i
RADEFFECTSF = CalcArray()
End Function
I already try your code on some sample data and it works:
SAMPLE
From my experience (I am engineer too), most probably some of the data you are importing on the range aren´t numbers. Check it.
The Slope1 - Slope2 value, you can get 0 so place a condition. Same comment for b1.
Check line by line writing the values you are getting in a additional range to see exactly where it is failing, just keeping remaining code as a comment.F.e.
Function RADEFFECTSF(SFA As Range, FacetAngle As Range, FacetRadius As Range) As Variant
...
Pi = 4 * Atn(1)
ReDim CalcArray(1 To SFA.Cells.Count)
For i = 1 To SFA.Cells.Count
SFA_Radians = SFA(i) * Pi / 180
FacetAngle_Radians = FacetAngle(i) * Pi / 180
Slope1 = -Tan(SFA_Radians)
Slope2 = Tan(FacetAngle_Radians)
X1 = FacetRadius(i) * Sin(SFA_Radians)
CalcArray(i) = X1 'This line is just to return the data X1
'Y1 = FacetRadius(i) * Cos(SFA_Radians)
'b1 = Y1 - (Slope1 * X1)
'X2 = -FacetRadius(i) * Sin(FacetAngle_Radians)
'Y2 = FacetRadius(i) * Cos(FacetAngle_Radians)
'b2 = Y2 - (Slope2 * X2)
'If Slope1 <> Slope2 then
'Cx = (b2 - b1) / (Slope1 - Slope2)
'Else
'Place what it is expected when Slope1=Slope2
'End If
'Cy = (Slope1 * (Cx / (b1))) + b1
'CalcArray(i) = Cy - (FacetRadius(i) * Cos(SFA_Radians))
Next i
RADEFFECTSF = CalcArray()
End Function
Check that X1 is the one expected... and so on. Then you can find which one is the code line introducing the unexpected value.
Sorry to give that one as reply, but still I can´t make comments.
I get the error on gTempConvC = line. I think its the ^ but not sure what to replace it with since I can't see to find their use in Excel sheet. This formula was used in a sheet and now i'm converting it to vba
Function gTempConvC(thermistorCnt As Integer, refRCnt As Integer) As Single
Dim CoA As Single
Dim CoB As Single
Dim CoC As Single
Dim CoD As Single
Dim Rth As Single
Dim Kth As Single
CoA = 0.0009180023
CoB = 0.0001964561
CoC = 0.0000007061775
CoD = 0.00000005283566
Kth = -273.15 'Constant Degrees Kelvin
'=((A12*(71500+1000)/B12)-1000) where A12 is thermistorCnt & B12 refRCnt
Rth = ((thermistorCnt * (71500 + 1000) / refRCnt) - 1000)
'=(-273.15)+(CoA+CoB*LN(C12)+CoC*LN(C12)^2+CoD*LN(C12)^3)^-1
gTempConvC = (Kth) + (CoA + CoB * Log(Kth) + CoC * Log(Kth) ^ 2 + CoD * Log(Kth) ^ 3) ^ -1
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.
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