Excel seems to hang while running a UDF

[tkpmep]

I created the following UDF to perform a robust regression, and run it
against subsets of data in a column by writing formulas of the
following type:
=INDEX(TheilSenRegression(OFFSET($AZ6,0,0,22,1),OFFSET($AZ6,1,0,22,1)),
1)
=INDEX(TheilSenRegression(OFFSET($AZ7,0,0,22,1),OFFSET($AZ7,1,0,22,1)),
1)
....
=INDEX(TheilSenRegression(OFFSET($AZ57,0,0,22,1),OFFSET($AZ57,1,0,22,1)),
1)


Works like a charm while I have less than about 100 such formulae in
the spreadsheet. Any more, and Excel seems to go into an infinite
loop, and I have to eventually killl it. I then tried copying and
pasting values in 96 of the cells to ensure that it was not getting
overloaded (the algorithm is O(N^2) and it may take a while to
recompute the spreadsheet if there are large numbers of fomulae). Now
there are only 4 cells with formulae in them. But the behaviour does
not change - If I copy one of thse formulae to a fifth cell, Excel
goes into an infinite loop. I have tried creating a new spreadsheet -
same problem. Any thoughts?

Sincerely

Thomas Philips


Public Function TheilSenRegression(x As Range, y As Range)

'This function performs a Theil Sen regression, regressing y on x
'For details, refer to Rand Wilcox - Fundamentals of Modern
Statistical Methods or
'P.K. Sen, Estimates of the Regression Coefficient based on
Kendall's Tau, JASA,v 63,#324, Dec 1968pp. 1379-1389

Dim xx() As Double, yy() As Double, slopes() As Double


Nx = Application.WorksheetFunction.Max(x.Rows.Count,
x.Columns.Count)
Mx = Application.WorksheetFunction.Min(x.Rows.Count,
x.Columns.Count)

Ny = Application.WorksheetFunction.Max(y.Rows.Count,
y.Columns.Count)
My = Application.WorksheetFunction.Min(y.Rows.Count,
y.Columns.Count)


If Nx <> Ny Then
MsgBox ("This routine does not work with two ranges of
different lengths.")
Exit Function

ElseIf Nx = 1 Then
MsgBox ("Each range must be of length 2 or more.")
Exit Function

ElseIf Mx > 1 Then
MsgBox ("This routine handles only univariate regressions.
Choose a single row or column for x")
Exit Function

ElseIf Mx > 1 Then
MsgBox ("This routine handles only univariate regressions.
Choose a single row or column for y")
Exit Function

ElseIf result < 0 Or result > 2 Then
MsgBox ("The third parameter (result) must be 0, 1 or 2")
Exit Function

Else
N = Nx
nC2 = N * (N - 1) / 2
ReDim xx(1 To N)
ReDim yy(1 To N)
ReDim slopes(1 To nC2)

For i = 1 To N
If x.Cells(i).Value = "" Then
MsgBox ("X has one or more blank cells")
Exit Function
Else
xx(i) = x.Cells(i).Value
End If

If y.Cells(i).Value = "" Then
MsgBox ("Y has one or more blank cells")
Exit Function
Else
yy(i) = y.Cells(i).Value
End If

Next

End If


k = 0 'Compute slopes between points with unequal x values
For i = 1 To N - 1
For j = i + 1 To N
If xx(i) <> xx(j) Then
k = k + 1
slopes(k) = (yy(j) - yy(i)) / (xx(j) - xx(i))
End If
Next
Next


ReDim Preserve slopes(1 To k)


TheilSenSlope = Application.WorksheetFunction.Median(slopes)
TheilSenIntercept = Application.WorksheetFunction.Median(yy) -
TheilSenSlope * Application.WorksheetFunction.Median(xx)
TheilSenRegression = Array(TheilSenSlope, TheilSenIntercept)


End Function