Lowest value in top 80% of Total?
 

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

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

Ron ... (Good morning)

Thanks ... working great ... I have 3 TabSheets ... Your
way produced same results on 2 or 3 ... I am checking the
3rd one as my test file is coming up with same value as
your Function ...

Next ... Can I rename this Function to something easier
for me to remember ...

From ... =lvt8v($as$2:$as$5000)
To ... = ??????($as$2:$as$5000)

Thanks Ron ... I may get there from here ... Kha



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

To change the name to ron() just change it and any reference in the function
to the old name.

--
Don Guillett
SalesAid Software

"Ken" wrote in message
...
Ron ... (Good morning)

Thanks ... working great ... I have 3 TabSheets ... Your
way produced same results on 2 or 3 ... I am checking the
3rd one as my test file is coming up with same value as
your Function ...

Next ... Can I rename this Function to something easier
for me to remember ...

From ... =lvt8v($as$2:$as$5000)
To ... = ??????($as$2:$as$5000)

Thanks Ron ... I may get there from here ... Kha



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

On Thu, 10 Feb 2005 08:19:28 -0800, "Ken"
wrote:

Ron ... (Good morning)

Thanks ... working great ... I have 3 TabSheets ... Your
way produced same results on 2 or 3 ... I am checking the
3rd one as my test file is coming up with same value as
your Function ...

Next ... Can I rename this Function to something easier
for me to remember ...

From ... =lvt8v($as$2:$as$5000)
To ... = ??????($as$2:$as$5000)

Thanks Ron ... I may get there from here ... Kha


I glad it's working.

To change the name of the function, you merely change all instance of the
current name to whatever you want.

I would use the Edit function.

For example, to change the UDF name to Foo:

With your module open, in the VBEditor Main Menu Bar select
Edit/Replace
Find What: lvt8v
Replace With: Foo
Search Current Module

Replace All


--ron