dragging array UDFs

[Eduardo]

Hi I built an array function and it is working well. However when I dra
it to other cel regions I got the message "VALUE". The exact formul
and the code is below.

Thanks for any help.

Eduardo

Exact formula:
{=samLMR(B5:B20;0;0)}


Code: x is a sorted array.


Public Function samLMR(x As Variant, Optional a As Double = 0#
Optional b As Double = 0#) As Variant
Dim xmom() As Double
Dim xm() As Double
Dim sum(8) As Double

Dim R As Integer
Dim C As Integer
Dim ReturnColumn As Boolean

R = Selection.Rows.Count
C = Selection.Columns.Count

n = x.Count
n = n - nfails

If R < C Then
nmom = C - 1
Else
nmom = R - 1
End If

zero = 0
one = 1

mn = Application.WorksheetFunction.Min(20, n)

If (nmom > mn) Then
AlertMSG (" *** error *** routine samLMR : parameter nmo
invalid.")
Exit Function
End If

For i = 1 To nmom
sum(i) = zero
Next i

If (a <> zero) Or (b <> zero) Then
If (a <= -one) Or (a >= b) Then
AlertMSG (" *** error *** routine samLMR : plotting-positio
parameters invalid.")
Exit Function
End If
'
' PLOTTING-POSITION ESTIMATES OF PWM'S
'
For i = 1 To n
ppos = (i + a) / (n + b)
term = x(i)
sum(1) = sum(1) + term
For j = 2 To nmom
term = term * ppos
sum(j) = sum(j) + term
Next j
Next i

For j = 1 To nmom
sum(j) = sum(j) / n
Next j
Else
'
' UNBIASED ESTIMATES OF PWM'S
'
For i = 1 To n
z = i
term = x(i)
sum(1) = sum(1) + term
For j = 2 To nmom
z = z - one
term = term * z
sum(j) = sum(j) + term
Next j
Next i
y = n
z = n
sum(1) = sum(1) / z
For j = 2 To nmom
y = y - one
z = z * y
sum(j) = sum(j) / z
Next j
End If ' (a <> zero) Or (b <> zero) Then ...

'
' L-MOMENTS
'

k = nmom
p0 = one
If (nmom - Fix(nmom / 2) * 2 = 1) Then
p0 = -one
End If

For kk = 2 To nmom
ak = k
p0 = -p0
p = p0
temp = p * sum(1)
For i = 1 To k - 1
AI = i
p = -p * (ak + AI - one) * (ak - AI) / (AI * AI)
temp = temp + p * sum(i + 1)
Next i
sum(k) = temp
k = k - 1
Next kk

ReDim xmom(nmom)
xmom(1) = sum(1)

If (nmom > 1) Then

xmom(2) = sum(2)

If (sum(2) = zero) Then
AlertMSG (" *** error *** routine samLMR : all data value
equal.")
Exit Function
End If

If (nmom > 2) Then
For k = 3 To nmom
xmom(k) = sum(k) / sum(2)
Next k
End If

End If

ReturnColumn = False
If R > 1 Then
If C > 1 Then
ReDim xm(R, C)
Else
ReDim xm(R)
ReturnColumn = True
End If
Else
ReDim xm(C)
End If

For i = 1 To nmom + 1
If i <= 2 Then
xm(i) = xmom(i)
ElseIf i = 3 Then
xm(i) = xmom(2) / xmom(1)
Else
xm(i) = xmom(i - 1)
End If
Next i

If ReturnColumn = True Then
samLMR = Application.WorksheetFunction.Transpose(xm)
Else
samLMR = xm
End If

End Function 'samLMR

 

[Frank Kabel]

Hi Eduardo
ee your reply in the other thread
P.S.: please don't multipost