View Single Post
  #1   Report Post  
Posted to microsoft.public.excel.programming
festdaddy festdaddy is offline
external usenet poster
 
Posts: 23
Default function works okay, unless I save personal.xlsb

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(ptrn g), 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