View Single Post
  #2   Report Post  
Ron Rosenfeld
 
Posts: n/a
Default

On Thu, 10 Feb 2005 04:31:46 -0800, "Ken"
wrote:

Excel 2000 ... What I have

# of records ... <5000
Col AS ... Formulas producing random numeric values (0 to
20,000,000)

I would like a Formula (Cell AT2) to produce the lowest
value found within the top 80% Volume Total of Col AS.

To do this manually I:

Sort Col AS Descending
Select all values in Col AS to determine Total Sum
Use calculator ... (Total Sum)*(.8)= 80% Volume Total
Select all values in Col AS down to 80% Volume Total
Obtain lowest value from this range
Use above value in another formula

If I could make this happen with a formula in a single
cell ... then I could reference this cell with my formulas
rather than always having to determine & use hard values.

Thanks ... Kha


I'm sure it could be done with a formula, but it seems simpler to write a short
UDF in VBA.

To enter this UDF, alt-F11 opens the VB Editor. Ensure your project is
highlighted in the Project Explorer window, then Insert/Module and paste the
code below into the window that opens.

To use the formula, enter =lvt8v(rng) in AT2 where rng represents the values in
col AS. The UDF will run faster if you do not select the entire column (eg
AS1:AS5000 will run faster than AS:AS).

=============================================
Option Explicit

Function LVT8V(rg As Range) As Double
Dim c As Range
Dim V() As Double
Dim Vol20 As Double
Dim i As Long
Dim Temp As Double

Vol20 = 0.2 * Application.WorksheetFunction.Sum(rg)

ReDim V(rg.Count - 1)

i = 0
For Each c In rg
V(i) = c.Value
i = i + 1
Next c

'sort range

BblSort V

'find lowest

For i = 0 To UBound(V)
Temp = Temp + V(i)
If Temp Vol20 Then
LVT8V = V(i)
Exit Function
End If
Next i


End Function

Private Function BblSort(TempArray As Variant)
Dim Temp As Variant
Dim i As Long
Dim NoExchanges As Long

' Loop until no more "exchanges" are made.
Do
NoExchanges = True

' Loop through each element in the array.
For i = 0 To UBound(TempArray) - 1

' If the element is greater than the element
' following it, exchange the two elements.
If TempArray(i) TempArray(i + 1) Then
NoExchanges = False
Temp = TempArray(i)
TempArray(i) = TempArray(i + 1)
TempArray(i + 1) = Temp
End If
Next i
Loop While Not (NoExchanges)

End Function

====================================

HTH,

--ron