Ramanujan Function in VBA - excel

I am trying to achieve the Ramanujan Function by using VBA. The formula is in the picture below.
My code is:
Function ramanuian(n)
left_part = (Application.sqrt(8) / 9801)
Dim temp As Double
temp = 0
For i = 0 To n
middle_part = Application.Fact(4 * i) / Application.Power(Application.Fact(i), 4)
right_part = (1103 + 26930 * i) / Application.Power(396, 4 * i)
ramanuian_reciprocal = middle_part * right_part
temp = temp + ramanuian_reciprocal
Next
ramanuian = 1 / (left_part * temp)
End Function
However, when I run this formula in Excel, it shows me an #Value! error. What is wrong with my code?

Related

Rearrange equation to solve for a different variable

I am looking at VBA code (function) written by someone else.
Here is the code:
Function EuropeanDelta(StrikePrice, MarketPrice, Volatility, InterestRate As Double, PC As String, ValueDate, ExpiryDate As Date, Optional PriceOrYield As String = "P") As Double
Rem Declare our working variables
Dim r As Double
Dim d1 As Double
Dim d2 As Double
Dim t As Double
Dim SqT As Double
Rem End of variable declaration
If PriceOrYield = "Y" Then
MarketPrice = 100 - MarketPrice
StrikePrice = 100 - StrikePrice
If PC = "C" Then
PC = "P"
Else
PC = "C"
End If
End If
Rem Initiase our working variables
t = (ExpiryDate - ValueDate) / 365
SqT = Sqr(t)
r = Application.WorksheetFunction.Ln(1 + InterestRate)
d1 = (Application.WorksheetFunction.Ln(MarketPrice / StrikePrice) + (Volatility * Volatility * 0.5) * t) / (Volatility * SqT)
Rem Quick logic to deal with Calls or Puts
If PC = "C" Then
EuropeanDelta = Exp(-r * t) * Application.WorksheetFunction.NormSDist(d1)
Else
EuropeanDelta = -Exp(-r * t) * Application.WorksheetFunction.NormSDist(-d1)
End If
If PriceOrYield = "Y" Then
EuropeanDelta = EuropeanDelta * -1
End If
End Function
The whole problem is based around the line for "d1". I would like to re-organise to solve for "StrikePrice". I have tried writing it out mathematically and then re-arranging, then swapping back to VBA.
#duffymo is correct, but am giving the answer directly in terms of VBA code
' d1 = (Log(MarketPrice / StrikePrice) + (Volatility * Volatility * 0.5) * t) / (Volatility * Sqr(t))
'
' Volatility * Sqr(t) * d1 = Log(MarketPrice / StrikePrice) + Volatility^2 * t/2
'
' Log(MarketPrice / StrikePrice) = Volatility * Sqr(t) * d1 - Volatility^2 * t/2
'
' MarketPrice / StrikePrice = Exp(Volatility * Sqr(t) * d1 - Volatility^2 * t/2)
'
StrikePrice = MarketPrice / Exp(Volatility * Sqr(t) * d1 - Volatility^2 * t/2)
Other Notes :
For brevity replace Application.WorksheetFunction.Ln() with Log()
There is no need cache SqT = Sqr(t) since it is only used once.
For clarity replace Volatility*Volatility with Volatility^2 as internally it does the same thing.
This is just algebra - high school math.
Take it in steps. Make sure you do the same operation to both sides to make sure that equality still holds.
Here's your starting equation:
d = {ln(m/s) + v*v*t/2}/(v*sqrt(t))
Multiply both sides by the denominator of the RHS:
d*v*sqrt(t) = ln(m/s) + v*v*t/2
Subtract v*v*t/2 from both sides:
(d*v*sqrt(t) - v*v*t/2) = ln(m/s)
Apply the exponential function to both sides, noting that exp(ln(x)) = x:
exp(d*v*sqrt(t) - v*v*t/2) = m/s
Multiply both sides by s:
s*exp(d*v*sqrt(t) - v*v*t/2) = m
Divide both sides by exp(d*v*sqrt(t) - v*v*t/2) to get the desired result:
s = m/exp(d*v*sqrt(t) - v*v*t/2)
Let's see if this function makes sense.
At t = 0 the denominator exp(0) = 1, so the strike price is equal to the market price.
As t -> infinity, we hope that the denominator gets large so s -> zero. L'Hospital's Rule will help here.

What does this Excel VBA function do?

I don't know how to read VBA (excel). Can you help me and translate this function?
Function calculateDigit(value)
lenval = Len(value)
factor = 3
Sum = 0
For Index = lenval To 1 Step -1
Sum = Sum + (CInt(Mid(value, Index, 1)) * factor)
factor = 4 - factor
Next
calculateDigit = ((1000 - Sum) Mod 10)
End Function

How to return value in Excel UDF Function?

I got some code written in a function in VBA, but I'm stuck on how to return the output values areaAnswer1 & areaAnswer2 inside the if - else statments. I'm still new to this. Any help & suggestions are very much appreciated.
Function dateArea(inputDate1 As Date, t1 As Date, t2 As Date, duration As Integer, output As Integer) As Integer
endOfYear = Workbook.Date(Year(inputDate1), 12, 31)
inputDate2 = Workbook.Date(Year(inputDate1) + 1, Month(inputDate1), Day(inputDate1))
endOfDate1 = Workbook.Date(Year(inputDate1) + duration, Month(inputDate1), Day(inputDate1))
endOfDate2 = Workbook.Date(Year(inputDate2) + duration, Month(inputDate2), Day(inputDate2))
areaBase1 = endOfYear - inputDate1
areaBase2 = inputDate2 - endOfYear
totalArea1 = areaBase1 * 365
totalArea2 = areaBase2 * 365
triangleBase1 = endOfDate1 - inputDate1
triangleHypo1 = Workbook.Sqrt((365 * 365) + (triangleBase1 * triangleBase1))
triangleBase2 = t1 - inputDate2
triangleHypo2 = triangleHypo1 * triangleBase2 / triangleBase1
triangleHeight2 = Workbook.Sqrt((triangleHypo2 * triangleHypo2) - (triangleBase2 * triangleBase2))
triangleArea2 = (triangleBase2 * triangleHeight2) / 2
triangleBase3 = (inputDate2 - endOfYear) + (t1 - inputDate2)
triangleHypo3 = triangleBase3 * triangleHypo2 / (t1 - inputDate2)
triangleHeight3 = Workbook.Sqrt((triangleHypo3 * triangleHypo3) - (triangleBase3 * triangleBase3))
triangleArea3 = (triangleBase3 * triangleBaseHeight3) / 2
areaDiffBot2 = triangleArea3 - triangleArea2
triangleBase4 = 365 + (t1 - inputDate2)
triangleHypo4 = triangleBase4 * triangleHeight2 / (t1 - inputDate2)
triangleHeight4 = Workbook.Sqrt((triangleHypo4 * triangleHypo4) - (triangleBase4 * triangleBase4))
triangleArea4 = (triangleBase4 * triangleHeight4) / 2
areaDiffBot1 = triangleArea4 - triangleArea3
triangleHeight5 = 365 * (endOfDate1 - t2) / triangleBase1
triangleHypo5 = Workbook.Sqrt((triangleHeight5 * triangleHeight5) + ((endOfDate1 - t2) * (endOfDate1 - t2)))
triangleArea5 = (endOfDate1 - t2) * triangleHeight5 / 2
triangleBase6 = (endOfDate1 - t2) + areaBase1
triangleHeight6 = (triangleBase6) * 365 / (endOfDate1 - t2)
triangleHypo6 = Workbook.Sqrt((triangleBase6 * triangleBase6) + (triangleHeight6 * triangleHeight6))
triangleArea6 = (triangleBase6 * triangleHeight6) / 2
areaDiffTop1 = triangleArea6 - triangleArea5
triangleBase7 = triangleBase6 + areaBase2
triangleHeight7 = triangleBase7 * triangleHeight6 / triangleBase6
triangleHypo7 = Workbook.Sqrt((triangleBase7 * triangleBase7) + (triangleHeight7 * triangleHeight7))
triangleArea7 = (triangleBase7 * triangleHeight7) / 2
areaDiffTop2 = triangleArea7 - triangleArea6
totalUsedArea1 = areaDiffTop1 + areaDiffBot1
totalUsedArea2 = areaDiffTop2 + areaDiffBot2
areaAnswer1 = totalArea1 - totalUsedArea1
areaAnswer2 = totalArea2 - totalUsedArea2
If output = 1 Then
ElseIf output = 2 Then
ElseIf output = 3 Then
Else
End If
End Function
In VBA you set the return value by assigning it to the function like this:
areaAnswer1 = totalArea1 - totalUsedArea1
areaAnswer2 = totalArea2 - totalUsedArea2
If output = 1 Then
dateArea = areaAnswer1
ElseIf output = 2 Then
dateArea = areaAnswer2
ElseIf output = 3 Then
' ...etc
Note that the assignment to the function does not exit the function. In this case you don't need that immediate exit, as you are already at the end of it. But in some cases you'll want to exit the function as soon as you have assigned the return value:
Exit Function
Just have the function equal a typed value or one of the variables at the end.
select case output
case 1
dateArea = totalUsedArea1
case 2
dateArea = totalUsedArea2
case 3
dateArea = totalUsedArea3
case else
'do something or nothing
end select
Note that you have specified returning an integer which cannot contain a decimal and must be smaller than 32667 (or there abouts).

Excel (2007) function does not calculate when I open the file (Automatic calculation)

I have created a function via vba and I have used this function to make an iterative table. I have set the workbook calculation to automatic and it all works fine but when I open the excel file, the cells that contain the mentioned function, give me #name error and everytime I need to recalculate. Is there a way to fix this?
Public Function FrictionFactor(relativeroughness, reynoldsnumber)
'Dim relativeroughness, reynoldsnumber As Double
fNext = 0.005 ' initial value for f
fIncrement = 0.005 ' initial step size
Convergence = 0.000001 ' sets the decimal place accuracy of the result
Do
fStart = fNext
LHSColebrookStart = 1 / (fStart ^ 0.5)
RHSColebrookStart = -2 * (Log((relativeroughness / 3.7) + (2.51 / (reynoldsnumber * (fStart ^ 0.5)))) / Log(10))
DifferenceStart = LHSColebrookStart - RHSColebrookStart
fNext = fStart + fIncrement
LHSColebrookNext = 1 / (fNext ^ 0.5)
RHSColebrookNext = -2 * (Log((relativeroughness / 3.7) + (2.51 / (reynoldsnumber * (fNext ^ 0.5)))) / Log(10))
DifferenceNext = LHSColebrookNext - RHSColebrookNext
If DifferenceStart * DifferenceNext < 0 Then ' march f in opposite direction and more slowly
fIncrement = fIncrement / -10
ElseIf DifferenceStart * DifferenceNext = 0 Then ' done
fIncrement = 0
End If ' keep marching f in same direction and at same rate
Loop While Abs(fStart - fNext) > Convergence
FrictionFactor = fStart
End Function
The usual reason this happens is that macros are not enabled when the workbook is opened. Check your Security settings.

My VBA code is aborting unexpectedly upon exiting a 'While' loop. Why?

I am new to VBA coding. I have done some coding in Javascript and C++, so I do understand the concepts. I'm not too familiar with the specifics of VBA, though. This particular code is for Excel 2007. The sort function was copied from elsewhere as pseudocode (documentation is not mine). I've rewritten it as VBA (unsuccessfully).
This code is not working properly. The code is abruptly aborting entirely (not just jumping out of a loop or function, but quitting completely after going through the While loop twice.
To replicate the problem, save this code as a Macro for an Excel sheet, type the number 9853 in B5, and in B6 type "=Kaprekar(B5)". Essentially, run Kaprekar(9853).
Could someone please help me figure out what I'm doing wrong here? Thanks.
By the way, I'm using While-Wend now. I also tried Do While-Loop with the same result.
Here's the code:
Function Sort(A)
limit = UBound(A)
For i = 1 To limit
' A[ i ] is added in the sorted sequence A[0, .. i-1]
' save A[i] to make a hole at index iHole
Item = A(i)
iHole = i
' keep moving the hole to next smaller index until A[iHole - 1] is <= item
While ((iHole > 0) And (A(iHole - 1) > Item))
' move hole to next smaller index
A(iHole) = A(iHole - 1)
iHole = iHole - 1
Wend
' put item in the hole
A(iHole) = Item
Next i
Sort = A
End Function
Function Kaprekar%(Original%)
Dim Ord(0 To 3) As Integer
Ord(0) = Original \ 1000
Ord(1) = (Original - (Ord(0) * 1000)) \ 100
Ord(2) = (Original - (Ord(1) * 100) - (Ord(0) * 1000)) \ 10
Ord(3) = (Original - (Ord(2) * 10) - (Ord(1) * 100) - (Ord(0) * 1000))
If (Ord(0) = Ord(1)) * (Ord(1) = Ord(2)) * (Ord(2) = Ord(3)) * (Ord(3) = Ord(0)) = 1 Then
Kaprekar = -1
Exit Function
End If
Arr = Sort(Ord)
Kaprekar = Ord(3)
End Function
excel evaluates both items in the while statement, so
While ((ihole > 0) And (A(ihole - 1) > item))
when ihole=0, returns false for the first test, and out of bounds for the second test, bombing out of the function with a #Value error.
A quick bubblesort would be something like this:
Option Explicit
Function Sort(A)
Dim iLoop As Long
Dim jLoop As Long
Dim Last As Long
Dim Temp
Last = UBound(A)
For iLoop = 0 To Last - 1
For jLoop = iLoop + 1 To Last
If A(iLoop) > A(jLoop) Then
Temp = A(jLoop)
A(jLoop) = A(iLoop)
A(iLoop) = Temp
End If
Next jLoop
Next iLoop
Sort = A
End Function

Resources