Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 16
Default Problem with Statistical UDFs

You will generally get a must faster response if you don't make people guess
at what your function is supposed to do and with what kind of data.

Jerry

"pablocampbell" wrote:


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


+-------------------------------------------------------------------+
|Filename: StatsPAC.zip |
|Download: http://www.excelforum.com/attachment.php?postid=4116 |
+-------------------------------------------------------------------+

--
pablocampbell
------------------------------------------------------------------------
pablocampbell's Profile: http://www.excelforum.com/member.php...o&userid=29592
View this thread: http://www.excelforum.com/showthread...hreadid=492958


Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
Help and description for UDFs [email protected] Excel Worksheet Functions 0 March 13th 07 05:05 AM
Problem with Statistical UDFs Tom Ogilvy Excel Programming 0 December 13th 05 01:05 PM
UDFs DoctorG Excel Programming 3 July 5th 05 01:49 PM
'portable' UDFs??? whelanj[_7_] Excel Programming 1 July 9th 04 01:13 PM
Acrobat 6.0 and UDFs Mike Lee[_2_] Excel Programming 0 January 29th 04 04:07 PM


All times are GMT +1. The time now is 04:33 PM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Copyright ©2004-2024 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"