LinkBack URL
About LinkBacks
OK Fellas,
I'm new to this, that is, to this forum, and to Excel UDFs in VBA.
I wrote some multicell-argument UDFs (actually 5 on one module) and was able to execute the functions once on a worksheet.
However, when I tried to excute a second time using a second set of arguments on the same worksheet, I got the #VALUE Error for four(4) of the five(5) cases. The excel file with the UDFs is attached. The UDF that was successfully recalculated using another multicell argument is AbunGeo(). The other four give me errors after one successful implementation on th worksheet. AbunGeo() had been the first in the code, so I flipped order to see if putting AbunLog() first would make a difference. I'm clueless, and a bit of a dummy here. dont see why flipping the order should make a difference, but I'm desperate.
I have no clue what's wrong but I'm hoping this is no big deal - that I'm just clueless about the obvious.
Can you help?
Remember, I'm new to this. Are there some standard precationary procedures that I'm missing?
Paul
PS: Code of the first 3 function shown below (couldnt do all cuz of post size limit). Zip of the excel file is also attached
-----------------------------------------------------------
Option Base 1
Option Explicit
Function AbunLog(ByVal AllData As Range, ByVal SClass As Range) As Variant
Const xtol As Double = 0.00001
Dim n As Long
Dim m As Long
Dim i As Long
Dim x As Double
Dim xnxt As Double
Dim xerr As Double
Dim AData As Variant
Dim alpha As Double
Dim NumClass As Integer
Dim ObsClass() As Double
Dim ExpClass() As Double
Dim MinSpec As Long
Dim MaxSpec As Long
Dim SumSpec As Long
Dim NumSpec As Long
Dim EData As Double
Dim ChiSqr As Double
Dim iClass As Long
Dim S_N As Double
Dim SpClass As Variant
Dim SpecClass As Double
Dim NLog As Double
NLog = 2
SpClass = SClass
SpecClass = SClass(1, 1)
AData = AllData
NumSpec = UBound(AData, 1)
SumSpec = WorksheetFunction.Sum(AData)
MaxSpec = WorksheetFunction.Max(AData)
S_N = NumSpec / SumSpec
NumClass = Round(Log(MaxSpec) / Log(NLog))
ReDim ObsClass(NumClass)
ReDim ExpClass(NumClass)
x = 0.99
Do
xnxt = -Log(1 - x) / (S_N - Log(1 - x))
xerr = Abs(xnxt - x) / x
x = xnxt
n = n + 1
Loop While (xerr > xtol) And (n < 50)
alpha = SumSpec * (1 - x) / x
iClass = 1
ObsClass(1) = 0
For m = 1 To NumSpec
i = NumSpec - m + 1
If AData(i, 1) < (NLog ^ iClass + 0.5) Then
ObsClass(iClass) = ObsClass(iClass) + 1
Else
iClass = iClass + 1
ObsClass(iClass) = 0
m = m - 1
End If
Next m
iClass = 1
ExpClass(1) = 0
For m = 1 To (NLog ^ NumClass)
If m < (NLog ^ iClass + 0.5) Then
ExpClass(iClass) = ExpClass(iClass) + (alpha * (x ^ m)) / m
Else
iClass = iClass + 1
ExpClass(iClass) = 0
m = m - 1
End If
Next m
ExpClass(NumClass) = 0
ExpClass(NumClass) = NumSpec - WorksheetFunction.Sum(ExpClass)
ChiSqr = 0
If (SpecClass < 1) Or (SpecClass > NumClass) Then
For m = 1 To NumClass
ChiSqr = ChiSqr + (ExpClass(m) - ObsClass(m)) ^ 2 / ExpClass(m)
AbunLog = ChiSqr
Next m
Else
AbunLog = ExpClass(SpecClass)
End If
If n = 50 Then
AbunLog = "Error"
End If
End Function
Function AbunGeo(ByVal AllData As Range, ByVal SpecData As Range) As Variant
Const ktol As Double = 0.00001
Dim n As Long
Dim m As Long
Dim i As Long
Dim k As Double
Dim knxt As Double
Dim kerr As Double
Dim ChiSqr As Double
Dim AData As Variant
Dim SData As Variant
Dim SDAdd As String
Dim Nratio As Double
Dim MinSpec As Long
Dim MaxSpec As Long
Dim NumSpec As Long
Dim SumSpec As Long
Dim Ck As Double
Dim iSpec As Long
Dim EData As Double
Dim NiSpec As Double
AData = AllData
NumSpec = UBound(AData, 1)
MinSpec = WorksheetFunction.Min(AData)
MaxSpec = WorksheetFunction.Max(AData)
SumSpec = WorksheetFunction.Sum(AData)
Nratio = MinSpec / SumSpec
k = 1
Do
knxt = 1 - ((1 - (1 - k) ^ NumSpec) * Nratio / k) ^ (1 / (NumSpec - 1))
kerr = Abs(knxt - k) / k
k = knxt
n = n + 1
Loop While (kerr > ktol) And (n < 50)
Ck = 1 / (1 - (1 - k) ^ NumSpec)
iSpec = SpecData.Row - AllData.Row + 1
ChiSqr = 0
If (iSpec > NumSpec) Or (iSpec < 1) Then
For m = 1 To NumSpec
EData = SumSpec * Ck * k * (1 - k) ^ (m - 1)
ChiSqr = ChiSqr + (EData - AData(m, 1)) ^ 2 / EData
AbunGeo = ChiSqr
Next m
Else
NiSpec = SumSpec * Ck * k * (1 - k) ^ (iSpec - 1)
AbunGeo = NiSpec
End If
If n = 50 Then
AbunGeo = "Error"
End If
End Function
Function AbunTln(ByVal AllData As Range, ByVal SClass As Range) As Variant
Dim m As Long
Dim i As Long
Dim AData As Variant
Dim ChiSqr As Double
Dim gamma As Double
Dim theta As Double
Dim NumClass As Integer
Dim ObsClass() As Double
Dim ExpClass() As Double
Dim MinSpec As Long
Dim MaxSpec As Long
Dim SumSpec As Long
Dim NumSpec As Long
Dim EData As Double
Dim iClass As Long
Dim MeanLog As Double
Dim MLog As Double
Dim VarLog As Double
Dim VLog As Double
Dim z0 As Double
Dim p0 As Double
Dim NSpec As Double
Dim TotSpec As Double
Dim SpClass As Variant
Dim SpecClass As Double
Dim NLog As Double
NLog = 2
SpClass = SClass
SpecClass = SClass(1, 1)
AData = AllData
NumSpec = UBound(AData, 1)
SumSpec = WorksheetFunction.Sum(AData)
MaxSpec = WorksheetFunction.Max(AData)
NumClass = Round(Log(MaxSpec) / Log(NLog))
ReDim ObsClass(NumClass)
ReDim ExpClass(NumClass)
iClass = 1
ObsClass(1) = 0
For m = 1 To NumSpec
i = NumSpec - m + 1
If AData(i, 1) < (NLog ^ iClass + 0.5) Then
ObsClass(iClass) = ObsClass(iClass) + 1
Else
iClass = iClass + 1
ObsClass(iClass) = 0
m = m - 1
End If
Next m
MLog = 0
For m = 1 To NumSpec
MLog = MLog + (Log(AData(m, 1)) / Log(10#))
Next m
MLog = MLog / NumSpec
MeanLog = MLog
VLog = 0
For m = 1 To NumSpec
VLog = VLog + ((Log(AData(m, 1)) / Log(10#)) - MeanLog) ^ 2
Next m
VLog = VLog / NumSpec
gamma = (VLog ^ 2) / ((MLog + 0.301029996) ^ 2)
If gamma < 0.23 Then
theta = Exp(1.46451 * (Log(gamma)) ^ 5 + 14.76956 * (Log(gamma)) ^ 4 + 59.76631 * (Log(gamma)) ^ 3 + 119.79856 * (Log(gamma)) ^ 2 + 122.17853 * (Log(gamma)) ^ 1 + 48.39711)
Else
theta = Exp(1.77458 * (Log(gamma)) ^ 5 + 8.64157 * (Log(gamma)) ^ 4 + 16.8518 * (Log(gamma)) ^ 3 + 16.66023 * (Log(gamma)) ^ 2 + 11.98243 * (Log(gamma)) ^ 1 + 3.6939)
End If
MeanLog = MLog - theta * (MLog + 0.301029996)
VarLog = VLog ^ 2 + theta * (MLog + 0.301029996) ^ 2
z0 = (-0.301029996 - MeanLog) / (VarLog ^ 0.5)
p0 = WorksheetFunction.NormSDist(z0)
NSpec = NumSpec / (1 - p0)
TotSpec = NSpec - NumSpec
For m = 1 To (NumClass - 1)
ExpClass(m) = NSpec * WorksheetFunction.NormSDist((Log(NLog ^ m + 0.5) / Log(10#) - MeanLog) / (VarLog ^ 0.5)) - TotSpec
TotSpec = TotSpec + ExpClass(m)
Next m
ExpClass(NumClass) = NSpec - TotSpec
ChiSqr = 0
If (SpecClass < 0) Or (SpecClass > NumClass) Then
For m = 1 To NumClass
ChiSqr = ChiSqr + (ExpClass(m) - ObsClass(m)) ^ 2 / ExpClass(m)
AbunTln = ChiSqr
Next m
Else
If SpecClass = 0 Then
AbunTln = NSpec - NumSpec
Else
AbunTln = ExpClass(SpecClass)
End If
End If
End Function
Register To Reply
Bookmarks