function works okay, unless I save personal.xlsb

  • Thread starter Thread starter festdaddy
  • Start date Start date
F

festdaddy

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...

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
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

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

If chksumbf < pcent Then
histomeat = "something's wrong"
Else
histomeat = trialareabf.Address
End If

End Function
 
festdaddy said:
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...
Click to expand...

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
Click to expand...

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
Click to expand...

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
Click to expand...

ActiveSheet can probably be removed from the above lines.
If chksumbf < pcent Then
histomeat = "something's wrong"
Click to expand...

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
 
Thanks Auric,
My biggest problem is I can't figure out why saving personal.xlsb changes the results of the cell that calls the function. Is this some kind of bug? If it wasn't totally clear in the first post: When I call the function from a cell formula, it works fine. If I then save personal.xlsb from within vba, my sheet is recalculated and the correct answer changes to an incorrect one.
 
festdaddy said:
Thanks Auric,
My biggest problem is I can't figure out why saving personal.xlsb
changes the results of the cell that calls the function. Is this some
kind of bug? If it wasn't totally clear in the first post: When I call
the function from a cell formula, it works fine. If I then save
personal.xlsb from within vba, my sheet is recalculated and the correct
answer changes to an incorrect one.
Click to expand...

Do you perhaps have some code in personal's Workbook_BeforeSave event? That's
the only thing that comes to mind.

(Yes, I believe that it *might* be a bug somewhere... but almost certainly
not in Excel.)
 
Back
Top