'Double' Random Selection in VBA

[sswcharlie]

Hi

Looking to make some vba for doing:

From list of 100 names - (dynamic named range say called 'Names')
Need to select a minimum of 4 (this qty # to be user selectable) random names and a maximum of 15 (qty # user selectable) names. note that on some occasions the min and max will be the same, say 15.

The vba will have to decide how many names to select first(between 4 and 15) and then select that quantity of names and place in a default dynamic named range in wb using xlup to locate.

Have checked the KB but nothing I can see does this.

Hope I have made clear for you. I have just played around with a basic random functions code. But would prefer to use vba.



Thankyou
Charles Harris

[mikerickson]

I think this will do what you want. Its not clear where the user selects the limits, so this code uses Input Boxes.
Neither is it clear where the results should be put.
This assumes that Names is a named column range.


Sub test()
Dim i As Long, temp As Variant, randIndex As Long
Dim arrNames As Variant
Dim userLowVal As Long, userHighVal As Long
Dim Size As Long

userLowVal = Application.InputBox("Minimum names chosen", Default:=4, Type:=1)
If userLowVal < 4 Or 15 < userLowVal Then Exit Sub
userHighVal = Application.InputBox("Maximum names chosen.", Default:=15, Type:=1)
If userHighVal < 4 Or 15 < userHighVal Then Exit Sub
If userHighVal < userLowVal Then
temp = userHighVal: userHighVal = userLowVal: userLowVal = temp
End If

arrNames = Application.Transpose(ThisWorkbook.Names("Names").RefersToRange.Value)
Size = UBound(arrNames, 1)

Randomize
For i = 1 To 15
randIndex = Int(Rnd() * Size) + 1
temp = arrNames(i)
arrNames(i) = arrNames(randIndex)
arrNames(randIndex) = temp
Next i

ReDim Preserve arrNames(1 To Application.RandBetween(userLowVal, userHighVal))

With ThisWorkbook.Names("defaultDynamic").RefersToRange.EntireColumn
With .Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
.Resize(UBound(arrNames), 1).Value = Application.Transpose(arrNames)
End With
End With
End Sub

[sswcharlie]

HiThanks for the code. I have opened a new wb and copied in the code. Created 2 dynamic ranges, Names and defaultDynamic . Code runs ok until past the second user input, and then comes up with message 'object doesn’t support this property or method' . A lot of the code is new to me and will need your help. Do not think it will be too much wrong. Using Excel2000.The input screens working well. ThanksCharles Harris

[mikerickson]

Are you sure that the name of the range is Names?

You also might try changing to this

Redim Preserve arrNames(1 To userLowValue + Int((userHighValue - userLowValue) * Rnd())

[Paul_Hossler]

similar



Option Explicit

Sub GetNames()
Dim vNames As Variant, vRand() As Variant, vOut() As String
Dim i As Long, j As Long, iMin As Long, iMax As Long
Dim dblHold As Double
Dim sHold As String

'testing
iMin = 5
iMax = 15

'Names is a VBA keyword, so I changed the name
vNames=
[ListOfNames].Value ' should be one statement

ReDim vRand(LBound(vNames, 1) To UBound(vNames, 1), 1 To 2)

For i = LBound(vRand, 1) To UBound(vRand, 1)
vRand(i, 1) = vNames(i, 1)
vRand(i, 2) = Rnd
Next I

'bubble sort
For i = 1 To UBound(vRand, 1) - 1
For j = 1 To UBound(vRand, 1)
If vRand(i, 2) < vRand(j, 2) Then
sHold = vRand(i, 1)
dblHold = vRand(i, 2)
vRand(i, 1) = vRand(j, 1)
vRand(i, 2) = vRand(j, 2)
vRand(j, 1) = sHold
vRand(j, 2) = dblHold
End If
Next j
Next i
'make output array
ReDim vOut(1 To iMax - iMin + 1, 1 To 1)
For i = LBound(vOut, 1) To UBound(vOut, 1)
vOut(i, 1) = vRand(i, 1)
Next I
'put in a range
ActiveSheet.Range("E1").Resize(UBound(vOut), 1).Value = vOut
End Sub

[mikerickson]

Here's a workbook.

[sswcharlie]

Hi everyone

Thanks for all the code and books. Just getting back onto this project. Will keep you informed. Regards

Charles

[sswcharlie]

Hi Paul and everyone

Looking at your workbook first book1.xls using XL2000

A lot of new unknown to me instructions. Trying to get my head around.
Some coments: The macro works well, but I notice it always results with 11 names from the list. Should the number of names vary between min and max?
I forgot in original email to state that the names when selected, should be placed in a specified table (say table "location 2", or col E as per your example) and then removed from the table from which it was taken. (column A "ListOfNames")
When going into the new table it will be dynamic and will go into the next available row.

BTW this is for the paperwork on a model railroad operating session, in which the the railroad cars will be taken on and off the train as the train progresses from location to location on the layout. Using random vba creates thee unknown for the operator!
The vba will finally run several trains in a day, and vba selects cars to drop off or pickup, for several locations for each train.

My first object is to get one train at one location working. There will be tables for each location and min max for that location of cars that it can hold. There will be a table for each train which will increase and decrease in size as it progresses.
I do want to be able to understand how the codes work and I am looking up now the uBound lBound etc. to understand what it does.
Hope this does not confuse too much. (I am retired and easliy confused!)
Will look at the other options soon.
No hurry for replies.
Thanks and regards
Charles

[sswcharlie]

Hi Mike Rickson

Having trouble to open your workbook1.xlsm

I am using at the moment XL2000. Try swchuck( at ) gmail (dot )com
Thankyou

Charles

[Paul_Hossler]

I think I didn't understand the way you were looking to use the Min and Max. Try this if you want to




Option Explicit
Sub GetNames()
Dim vNames As Variant, vRand() As Variant, vOut() As String
Dim i As Long, j As Long, iMin As Long, iMax As Long, iNum As Long
Dim dblHold As Double
Dim sHold As String

'testing
iMin = 5
iMax = 15


'I *think* this is available in Excel 2000
iNum = Application.WorksheetFunction.RandBetween(iMin, iMax)

'Names is a VBA keyword, so I changed the name
vNames =
[ListOfNames].Value

ReDim vRand(LBound(vNames, 1) To UBound(vNames, 1), 1 To 2)

For i = LBound(vRand, 1) To UBound(vRand, 1)
vRand(i, 1) = vNames(i, 1)
vRand(i, 2) = Rnd
Next i

'bubble sort
For i = 1 To UBound(vRand, 1) - 1
For j = 1 To UBound(vRand, 1)
If vRand(i, 2) < vRand(j, 2) Then
sHold = vRand(i, 1)
dblHold = vRand(i, 2)
vRand(i, 1) = vRand(j, 1)
vRand(i, 2) = vRand(j, 2)
vRand(j, 1) = sHold
vRand(j, 2) = dblHold
End If
Next j
Next i
'make output array
ReDim vOut(1 To iNum, 1 To 1)
For i = LBound(vOut, 1) To UBound(vOut, 1)
vOut(i, 1) = vRand(i, 1)
Next i
'put in a range
ActiveSheet.Range("E1").EntireColumn.ClearContents
ActiveSheet.Range("E1").Resize(UBound(vOut), 1).Value = vOut

Call MsgBox("There were " & iNum & " names randomly selected", vbOKOnly + vbInformation, "Select Random Names")
End Sub

[snb]

Assuming the names in C1:C100


Sub M_snb()
Randomize
sq = [C1:C100]
sn = [A1:A100]

For j = 1 To UBound(sn)
sn(j, 1) = Rnd
Next
[A1:A100] = sn
sn = [index(rank(A1:A100,A1:A100),)]

sp = Application.Index(sn, Evaluate("row(1:" & InputBox("Number of names") & ")"), 0)
For j = 1 To UBound(sp)
sp(j, 1) = sq(sp(j, 1), 1)
Next

Cells(1, 6).Resize(UBound(sp), 1) = sp
End Sub


the selection will be shown in column F