Creating a custom function with VBA Excel, error #VALUE - vba

Public Function CopperThermalConductivity(T As Double, RRR As Double)
Dim P1, P2, P3, P4, P5, P6, P7 As Double
Dim W0, W1, W10 As Double
Dim Beta, BetaR As Double
Beta = 0.634 / RRR
BetaR = Beta / 0.0003
P1 = 0.00000001754
P2 = 2.763
P3 = 1102
P4 = -0.165
P5 = 70
P6 = 1.756
P7 = 0.838 / (BetaR ^ 0.1661)
W0 = Beta / T
W1 = (P1 * (T ^ P2)) / (1 + (P1 * P3 * (T ^ (P2 + P4)) * WorksheetFunction.Exp(-(P5 / T) ^ P6)) + W0)
W10 = (P7 * W1 * W0) / (W1 + W0)
CopperThermalConductivity = (1 / (W0 + W1 + W10))
End Function
Sub DescribeFunctionCopper()
Dim FuncName As String
Dim FuncDesc As String
Dim ArgDesc(1 To 2) As String
FuncName = "CopperThermalConductivity"
FuncDesc = "Returns the Thermal Conductivity in W/m-K"
ArgDesc(1) = "Temperature in Kelvin"
ArgDesc(2) = "Residual-resistivity ratio"
Application.MacroOptions _
Macro:=FuncName, _
Description:=FuncDesc, _
ArgumentDescriptions:=ArgDesc, _
Category:="Cryogenics"
End Sub
I wrote some code to create an accessible function for Excel. Somehow when I use this function on Excel I get a #VALUE error, any idea? I don't get any error when I build the macro. Help me please.

This line is the source of error:
W1 = (P1 * (T ^ P2)) / (1 + (P1 * P3 * (T ^ (P2 + P4)) * WorksheetFunction.Exp(-(P5 / T) ^ P6)) + W0)
You cannot use worksheet function EXP in VBA code. There is VBA equivalent Exp() and it should be used instead of worksheet function.
By the way, note that when you declare variables like that:
Dim P1, P2, P3, P4, P5, P6, P7 As Double
Dim W0, W1, W10 As Double
Dim Beta, BetaR As Double
only P7, W10 and BetaR are declared as Double, other are declared as Variant. If you want to declare all those variables as Double you should do it like that:
Dim P1 As Double, P2 As Double, P3 As Double, P4 As Double, P5 As Double, P6 As Double, P7 As Double
Dim W0 As Double, W1 As Double, W10 As Double
Dim Beta As Double, BetaR As Double

Related

Any way to call Excel functions in VB.NET as Microsoft.Office.Interop.Excel throws Class not registered (REGB_E_CLASSNOTREG) in Server?

The application needs to use some Excel functions (NormSDist, NormSInv) to calculate some result. There is slight difference between the results by Excel and .NET equivalent of these functions. As it is a banking application the user wants exact match. So by referring Microsoft.Office.Interop.Excel and calling Excel functions NormSDist, NormSInv return exact result.
By referring Microsoft.Office.Interop.Excel
Dim appExcel As Microsoft.Office.Interop.Excel.Application = New Microsoft.Office.Interop.Excel.Application()
Dim wsf As Microsoft.Office.Interop.Excel.WorksheetFunction = appExcel.WorksheetFunction()
decOne = wsf.NormSInv(someValue) + wsf.NormSInv(someValue)
decTwo = 12.5 * wsf.NormSDist(decNorm)
.NET equivalent functions
Public Shared Function NORMSDIST(z As Double) As Double
Dim sign As Double = 1
If z < 0 Then
sign = -1
End If
Return 0.5 * (1.0 + sign * erf(Math.Abs(z) / Math.Sqrt(2)))
End Function
Private Shared Function erf(x As Double) As Double
Dim a1 As Double = 0.254829592
Dim a2 As Double = -0.284496736
Dim a3 As Double = 1.421413741
Dim a4 As Double = -1.453152027
Dim a5 As Double = 1.061405429
Dim p As Double = 0.3275911
x = Math.Abs(x)
Dim t As Double = 1 / (1 + p * x)
Return 1 - ((((((a5 * t + a4) * t) + a3) * t + a2) * t) + a1) * t * Math.Exp(-1 * x * x)
End Function
' This function is a replacement for the Microsoft Excel Worksheet function NORMSINV.
' It uses the algorithm of Peter J. Acklam to compute the inverse normal cumulative
' distribution. Refer to http://home.online.no/~pjacklam/notes/invnorm/index.html for
' a description of the algorithm.
' Adapted to VB by Christian d'Heureuse, http://www.source-code.biz.
Public Shared Function NormSInv(ByVal p As Double) As Double
Const a1 = -39.6968302866538, a2 = 220.946098424521, a3 = -275.928510446969
Const a4 = 138.357751867269, a5 = -30.6647980661472, a6 = 2.50662827745924
Const b1 = -54.4760987982241, b2 = 161.585836858041, b3 = -155.698979859887
Const b4 = 66.8013118877197, b5 = -13.2806815528857, c1 = -0.00778489400243029
Const c2 = -0.322396458041136, c3 = -2.40075827716184, c4 = -2.54973253934373
Const c5 = 4.37466414146497, c6 = 2.93816398269878, d1 = 0.00778469570904146
Const d2 = 0.32246712907004, d3 = 2.445134137143, d4 = 3.75440866190742
Const p_low = 0.02425, p_high = 1 - p_low
Dim q As Double, r As Double
Dim strErrMsg As String = ""
If p < 0 Or p > 1 Then
strErrMsg = "NormSInv: Argument out of range."
ElseIf p < p_low Then
q = Math.Sqrt(-2 * Math.Log(p))
NormSInv = (((((c1 * q + c2) * q + c3) * q + c4) * q + c5) * q + c6) /
((((d1 * q + d2) * q + d3) * q + d4) * q + 1)
ElseIf p <= p_high Then
q = p - 0.5 : r = q * q
NormSInv = (((((a1 * r + a2) * r + a3) * r + a4) * r + a5) * r + a6) * q /
(((((b1 * r + b2) * r + b3) * r + b4) * r + b5) * r + 1)
Else
q = Math.Sqrt(-2 * Math.Log(1 - p))
NormSInv = -(((((c1 * q + c2) * q + c3) * q + c4) * q + c5) * q + c6) /
((((d1 * q + d2) * q + d3) * q + d4) * q + 1)
End If
End Function
But as Excel is not in the server, it throws
Retrieving the COM class factory for component with CLSID{} failed due to the following error: 80040154 Class not registered (Exception from HRESULT: 0x80040154 (REGDB_E_CLASSNOTREG))
Is there any way to use Excel functions in .NET or is there any library to consume these Excel functions?
Note: This application just requires the Excel functions and it doesn't interact with any excel files
MathNet.Numerics library (https://numerics.mathdotnet.com/) works as expected.
Install-Package MathNet.Numerics -Version 3.20.0
In .vb file,
Imports MathNet.Numerics
As ExcelFunctions is a static class, directly call the methods as
decOne = ExcelFunctions.NormSInv(someValue) + ExcelFunctions.NormSInv(someValue)
decTwo = 12.5 * ExcelFunctions.NormSDist(decNorm)
The below link has the list of methods available
https://numerics.mathdotnet.com/api/MathNet.Numerics/ExcelFunctions.htm

VBA - Modular exponentiation

I've been trying to do Modular exponentiation in VBA for use in MS excel, but there seems to be a logical error which crashes Excel everytime i try to use the formula.
Function expmod(ax As Integer, bx As Integer, cx As Integer)
' Declare a, b, and c
Dim a As Integer
Dim b As Integer
Dim c As Integer
' Declare new values
Dim a1 As Integer
Dim p As Integer
' Set variables
a = ax
b = bx
c = cx
a1 = a Mod c
p = 1
' Loop to use Modular exponentiation
While b > 0
a = ax
If (b Mod 2 <> 0) Then
p = p * a1
b = b / 2
End If
a1 = (a1 * a1) Mod c
Wend
expmod = a1
End Function
I used the pseudocode which was provided here.
Here is an implementation I wrote a while back. Using Long rather than Integer enables it to handle higher exponents:
Function mod_exp(alpha As Long, exponent As Long, modulus As Long) As Long
Dim y As Long, z As Long, n As Long
y = 1
z = alpha Mod modulus
n = exponent
'Main Loop:
Do While n > 0
If n Mod 2 = 1 Then y = (y * z) Mod modulus
n = Int(n / 2)
If n > 0 Then z = (z * z) Mod modulus
Loop
mod_exp = y
End Function

VBA doesn't divide local variable (Error 6 overflow)

I'm trying to program a simple z-test but my code gives an error when calculating the Z-score with this code: Z = (P1 - P2) / SD; does anyone know why? The error that comes up is an overflow (error 6)
Here's the full code:
Sub ChiSquare()
Total_Groep_1 = Application.Sum(Range("C4", Range("C4").End(xlDown)))
Total_Groep_2 = Application.Sum(Range("E4", Range("E4").End(xlDown)))
For i = 5 To Range("C4").End(xlDown)
Dim P1 As Double
P1 = Cells(i, 3) / Total_Groep_1
Cells(i, 4) = P1
Dim P2 As Double
P2 = Cells(i, 5) / Total_Groep_2
Cells(i, 6) = P2
Dim SD As Double
SD = Sqr((P1 * (1 - P1) / Total_Groep_1) + (P2 * (1 - P2) / Total_Groep_2))
Cells(i, 7) = SD
Dim Z As Double
Z = (P1 - P2) / SD
Cells(i, 8) = Z
Next i
End Sub
The loop that I made didn't go to a number but to a range. It works now I changed that.

Calculating an exponentially weighted moving average

I am trying a fairly simple function to calculate an exponentially weighted moving average volatility in Excel VBA, following. However, I think there is some error in my function that I can't pinpoint, because I don't get the correct solution.
Function EWMA(numbers As Range, Lambda As Single) As Double
Dim mean As Double
Dim x As Double
Dim c As Range
Dim n As Integer
mean = WorksheetFunction.Average(numbers)
n = WorksheetFunction.Count(numbers)
For Each c In numbers
x = x + (Lambda ^ (n - c.Count)) * ((c.Value - mean) ^ 2)
Next c
EWMA = (1 - Lambda) * x
End Function
The values I am using and the target volatility (calculated using a spreadsheet EWMA) are here.
What am I doing wrong?
Update: using Ron Rosenfeld's solution:
Option Explicit
Function EWMA(Zero As Range, Lambda As Double) As Double
Dim vZero As Variant
Dim SumWtdRtn As Double
Dim I As Long
Dim vPrices As Variant
Dim LogRtn As Double, RtnSQ As Double, WT As Double, WtdRtn As Double
vZero = Zero
For I = 2 To UBound(vZero, 1)
vPrices = 1 / ((1 + vZero(I, 1)) ^ (3 / 12))
LogRtn = Log(vPrices(I - 1, 1) / vPrices(I, 1))
RtnSQ = LogRtn ^ 2
WT = (1 - Lambda) * Lambda ^ (I - 2)
WtdRtn = WT * RtnSQ
SumWtdRtn = SumWtdRtn + WtdRtn
Next I
EWMA = SumWtdRtn ^ (1 / 2)
End Function
Here's a little bit different way of doing it as a VBA function. The inputs are an array of prices, which is assumed to be in descending order as you show, and Lambda. Hopefully, the names of the variables will let you see the logic:
Option Explicit
Function EWMA2(Prices As Range, Lambda As Double) As Double
Dim vPrices As Variant
Dim dSumWtdRtn As Double
Dim I As Long
Dim dLogRtn As Double, dRtnSQ As Double, dWT As Double, dWtdRtn As Double
vPrices = Prices
For I = 2 To UBound(vPrices, 1)
dLogRtn = Log(vPrices(I - 1, 1) / vPrices(I, 1))
dRtnSQ = dLogRtn ^ 2
dWT = (1 - Lambda) * Lambda ^ (I - 2)
dWtdRtn = dWT * dRtnSQ
dSumWtdRtn = dSumWtdRtn + dWtdRtn
Next I
EWMA2 = dSumWtdRtn ^ (1 / 2)
End Function
With your data, it gives the same results as the spreadsheet calculation (within the limits of precision of the data types)
EDIT
If you want to input the 3M CAD Zero Rates as the range input, and not the pricing, then you could modify the above to compute the two relevant prices from the returns data. In this case, it would be:
Option Explicit
Function EWMAV(Zeros As Range, Lambda As Double) As Double
Dim vZeros() As Variant
Dim dPrice1 As Double, dPrice2 As Double
Dim dSumWtdRtn As Double
Dim I As Long
Dim dLogRtn As Double, dRtnSQ As Double, dWT As Double, dWtdRtn As Double
vZeros = Zeros
For I = 2 To UBound(vZeros, 1)
dPrice1 = 1 / ((1 + vZeros(I - 1, 1)) ^ (3 / 12))
dPrice2 = 1 / ((1 + vZeros(I, 1)) ^ (3 / 12))
dLogRtn = Log(dPrice1 / dPrice2)
dRtnSQ = dLogRtn ^ 2
dWT = (1 - Lambda) * Lambda ^ (I - 2)
dWtdRtn = dWT * dRtnSQ
dSumWtdRtn = dSumWtdRtn + dWtdRtn
Next I
EWMAV = dSumWtdRtn ^ (1 / 2)
End Function

Perlin Noise acting strange

I am trying to implement a 2D Perlin Noise in VB.Net. I've spent the whole day searching for sources that explain the subject and one of the most notable was this article by Hugo Elias
Most of the implementation went well. On the exception of a very important part that did not seem to work in VB.Net, causing overflows.
function Noise1(integer x, integer y)
n = x + y * 57
n = (n<<13) ^ n;
return ( 1.0 - ( (n * (n * n * 15731 + 789221) + 1376312589) & 7fffffff) / 1073741824.0);
end function
In VB.net I translated it to
Private Function Noise(tX As Integer, tY As Integer) As Double
'Return a double between -1 & 1 according to a fixed random seed
Dim n As Integer = tX + tY * 57
n = (n << 13) Xor n
Return (1.0 - ((n * (n * n * 15731 + 789221) + BaseSeed) And &H7FFFFFFF) / 1073741824.0)
End Function
Which cause overflows.
Since the idea seem to be to simply generate a fractional number between -1 and 1. I've made this little function which create a Integer Number based on the coordinates and BaseSeed. BaseSeed(999999) being the base for every noise I'll create in this particular part of my game.
Private Function Noise(tX As Integer, tY As Integer) As Double
Dim tSeed As Integer
tSeed = WrapInteger(789221, BaseSeed, (tX * 1087) + (tY * 2749))
RandomGenerator = New Random(tSeed)
Return (RandomGenerator.Next(-10000, 10001) / 10000)
End Function
WrapInteger simply makes sure that the number will always be in the range of an integer, to avoid overflow errors.
Public Function WrapInteger(ByVal Lenght As Integer, ByVal Position As Integer, ByVal Movement As Integer) As Integer
Lenght += 1
Return ((Position + Movement) + (Lenght * ((Abs(Movement) \ Lenght) + 1))) Mod Lenght
End Function
When I fire it up with a Persistence of 0.25, 6 Octaves and a starting frequency of 2. this is what I get. This is a 128x128 pixel bitmap that I scaled.
Result
Anyone have an idea of why it would be so linear? When I look at this picture I have the feeling that it's not far from the truth, as if it only worked in 1D. All suposition.
Below you will find my entire PerlinNoise Class. I think the rest of it is just fine, but I added it for reference purpose. Beside, I haven't been able to find a single VB implementation of Perlin Noise on the internet. So I guess if I can fix this one, it might help others. There seem to be alot of question about Perlin noise malfunction on StackOverflow
Public Class cdPerlinNoise
Private RandomGenerator As Random
Private BaseSeed As Integer
Private Persistence As Double
Private Frequency As Integer
Private Octaves As Integer
Public Sub New(tSeed As Integer, tPersistence As Double, tOctaves As Integer, tFrequency As Integer)
Frequency = tFrequency
BaseSeed = tSeed
Persistence = tPersistence
Octaves = tOctaves
End Sub
Private Function Noise(tX As Integer, tY As Integer) As Double
Dim tSeed As Integer
tSeed = WrapInteger(789221, BaseSeed, (tX * 1087) + (tY * 2749))
RandomGenerator = New Random(tSeed)
Return (RandomGenerator.Next(-10000, 10001) / 10000)
End Function
Private Function SmoothNoise(tX As Integer, tY As Integer) As Double
Dim Corners As Double = (Noise(tX - 1, tY - 1) + Noise(tX + 1, tY - 1) + Noise(tX - 1, tY + 1) + Noise(tX + 1, tY + 1)) / 16
Dim Sides As Double = (Noise(tX - 1, tY) + Noise(tX + 1, tY) + Noise(tX, tY - 1) + Noise(tX, tY + 1)) / 8
Return (Noise(tX, tY) / 4) + Corners + Sides
End Function
Private Function InterpolateCosine(tA As Double, tB As Double, tX As Double) As Double
Dim f As Double = (1 - Cos(tX * 3.1415927)) * 0.5
Return tA * (1 - f) + tB * f
End Function
Private Function Interpolate2D(tX As Double, tY As Double) As Double
Dim WholeX As Integer = CInt(Fix(tX))
Dim RemainsX As Double = tX - WholeX
Dim WholeY As Integer = CInt(Fix(tY))
Dim RemainsY As Double = tY - WholeY
Dim v1 As Double = SmoothNoise(WholeX, WholeY)
Dim v2 As Double = SmoothNoise(WholeX + 1, WholeY)
Dim v3 As Double = SmoothNoise(WholeX, WholeY + 1)
Dim v4 As Double = SmoothNoise(WholeX + 1, WholeY + 1)
Dim i1 As Double = InterpolateCosine(v1, v2, RemainsX)
Dim i2 As Double = InterpolateCosine(v3, v4, RemainsX)
Return InterpolateCosine(i1, i2, RemainsY)
End Function
Public Function PerlinValue(tX As Double, tY As Double) As Double
Dim Total As Double = 0
Dim Frequency As Double
Dim Amplitude As Double
For i = 0 To Octaves - 1
Frequency = Frequency ^ i
Amplitude = Persistence ^ i
Total = Total + (Interpolate2D(tX * Frequency, tY * Frequency) * Amplitude)
Next
Return Total
End Function
Public Function ScaleNoise(ByVal tX As Double, ByVal tY As Double, ByVal OutputLow As Double, ByVal OutputHigh As Double) As Double
Dim Range1 As Double
Dim Range2 As Double
Dim Result As Double
Range1 = 1 - -1
Range2 = OutputHigh - OutputLow
'(B*C - A*D)/R1 + n1*(R2/R1)
Result = (((1 * OutputLow) - (-1 * OutputHigh)) / Range1) + ((PerlinValue(tX, tY) * (Range2 / Range1)))
If Result < OutputLow Then
Return OutputLow
ElseIf Result > OutputHigh Then
Return OutputHigh
Else
Return Result
End If
End Function
End Class