Hi Jim,

Happy New Year !

In VBE Tools References,
I checked: atpvbaen.xls instead
(could not find ATPVBAIN.XLA)

But think I got your sub running well

How could your Sub WhoIsIt() be tweaked to write the results of say, 10 runs
into a col range instead ? Thanks.
--
Max
Singapore
http://savefile.com/projects/236895
xdemechanik
---
"Jim Cone" wrote in message
...
Also, the AnalysisToolPak must be checkmarked in Tools | Add-ins.

The code below is modified slightly. It fixes a subscript out of range
error,
adds a status bar message, adds some checks before the program runs
and an error handler...

Function TipTheScales_R1(ByRef rng As Excel.Range) As Variant
'---
'Picks a random value using weighted percent values in the selection.
'Percent values should be entered as a whole number.
'Return value is the cell text directly above the chosen percent value.
'Requires a reference (in the VBE) to ATPVBAIN.XLA in Tools | References
'Jim Cone - San Francisco, USA - December 31, 2006
'---
On Error GoTo OverWeight_Err
Dim varArr() As Variant
Dim varSum As Variant
Dim N As Long
Dim i As Long
Dim j As Long
Dim lngLcm As Long
Dim lngValue As Long
Dim lngPortion As Long

varSum = Application.Sum(rng)

If IsError(varSum) Then
TipTheScales_R1 = "Selection values must total 100. "
Exit Function
ElseIf varSum < 100 Then
TipTheScales_R1 = "Selection values must total 100. "
Exit Function
ElseIf rng.Rows.Count < 1 Then
TipTheScales_R1 = "Select only one row. "
Exit Function
Else
For N = 1 To rng.Count
If Not IsNumeric(rng(N)) Or Len(rng(N)) = 0 Then
TipTheScales_R1 = "All entries in the selection must be numbers.
"
Exit Function
End If
Next
End If

'Least Common Multiple
lngLcm = Lcm(rng)
ReDim varArr(1 To lngLcm, 1 To 2)
For N = 1 To rng.Count
lngValue = rng(N).Value
lngPortion = Int(lngLcm * lngValue / 100)
For i = 1 To lngPortion
varArr(j + i, 1) = lngValue
varArr(j + i, 2) = rng(N).Offset(-1, 0).Value
Next
j = j + lngPortion
Application.StatusBar = " WORKING " & Format$(N / rng.Count, "#00%")
Next
'Int((upperbound - lowerbound + 1) * Rnd + lowerbound)
Randomize
N = Int(lngLcm * Rnd) + 1
Application.Calculation = xlCalculationAutomatic
TipTheScales_R1 = varArr(N, 2) & " is a winner. "
Erase varArr
Set rng = Nothing
Exit Function
OverWeight_Err:
Beep
TipTheScales_R1 = "Error " & Err.Number & " - " & Err.Description
End Function

Sub WhoIsIt()
Application.Calculation = xlCalculationManual
MsgBox TipTheScales_R1(Selection)
Application.Calculation = xlCalculationAutomatic
Application.StatusBar = False
End Sub