festdaddy wrote:

I have a (rather clunky) function that works ok, but if I save
personal.xlsb it forces a re-calc of the sheet and the function result
changes. If I then recalc the cell with the function, it changes the
result back to being correct. I'm going nuts trying to figure out why.
Also I'd love to hear any suggestions for making this function less
clunky...

Wouldn't it make better sense to try to figure out why recalculating makes
the data "incorrect"? (Or am I misunderstanding your problem?)

FWIW, I don't see any obvious bugs in your code... but that's just in a few
seconds of reviewing.

A little background: I work with histograms quite a bit, and the data I
work with often has very long tails so I frequently need to look at just
the "meat" of the distribution. I wanted a function that would return
the smallest range that contained x% of the data. My code is below.

'------------------------------------------------------
Public Function histomeat(ptrng As Range, pcent As Double) As String

Dim trialareabf, maxlocadr As Range
Dim abv, blw As Double
'this is meant to be used with histograms mostly, as a way to find the
"meat" of the distribution 'the idea is to find the smallest number of
cells that account for x% of the data...

'set limits to range
minrow = ptrng.Rows(1).Row
maxrow = ptrng.Rows(ptrng.Rows.Count).Row

'start by identifying the maxbin location
maxloc = WorksheetFunction.Index(ptrng, WorksheetFunction.Match
(WorksheetFunction.Max(ptrng), ptrng, 0)).Address
Set maxlocadr = Range(maxloc)

'check back and forth...
Set trialareabf = maxlocadr
Do Until chksumbf = pcent Or loopcnt ptrng.Rows.Count
loopcnt = loopcnt + 1

It might make sense to change this to a For:Next loop, and check chksumbf
each iteration, like so:

For loopcnt = 1 To ptrng.Rows.Count
If chksumbf = pcent Then Exit For


tbminrw = trialareabf.Rows(1).Row
tbmaxrw = trialareabf.Rows(trialareabf.Rows.Count).Row

If WorksheetFunction.IsNumber(trialareabf.offset(-1, 0).Rows
(1).Value) = False Then
Else: abv = trialareabf.offset(-1, 0).Rows(1).Value
End If
If WorksheetFunction.IsNumber(trialareabf.offset(1, 0).Rows
(trialareabf.Rows.Count).Value) = False Then
Else: blw = trialareabf.offset(1, 0).Rows
(trialareabf.Rows.Count).Value
End If

The above two tests can be reversed (you're checking for False; they should
be checking for True instead) and changed from WorksheetFunction.IsNumber
to IsNumeric, like so:

If IsNumeric(trialareabf.Offset(-1, 0).Rows(1).Value) Then _
abv = trialareabf.Offset(-1, 0).Rows(1).Value
If IsNumeric(trialareabf.Offset(1, 0).Rows _
(trialareabf.Rows.Count).Value) Then _
blw = trialareabf.Offset(1, 0).Rows(trialareabf.Rows.Count).Value

(It'll look better unwrapped; both Ifs can be single lines.)

If blw < abv Then
Set trialareabf = ActiveSheet.Range(Cells(tbminrw - 1,
maxlocadr.Column), Cells(tbmaxrw, maxlocadr.Column))
Else
Set trialareabf = ActiveSheet.Range(Cells(tbminrw,
maxlocadr.Column), Cells(tbmaxrw + 1, maxlocadr.Column))
End If
chksumbf = WorksheetFunction.Sum(trialareabf)
Loop

ActiveSheet can probably be removed from the above lines.

If chksumbf < pcent Then
histomeat = "something's wrong"

It might be worthwhile for you to put an explicit error here. The code will
automagically break, and then you can examine your data and see what's
going on. It's as simple as this:

Error 1

....or:

Err.Raise 1

Else
histomeat = trialareabf.Address
End If

End Function

--
He is possibly the world's finest comedian,
although he has no idea that this is true.