Never saw your last two posts until today. I was unaware if this requirement
(but I probably should have thought of it and asked). If you want to ensure
that every location will always have at least one name selected, you could
change the statement to:

Txt$ =
"=IF(RC[-2]<R[-1]C[-2],INT(VLOOKUP(RC[-2],C[4]:C[5],2,FALSE)/10)+1,IF(R[-1]C=0,0,R[-1]C-1))"

This guarantees at least one name per location, but some locations could
wind end with an extra name selected.

Regards,

Hutch

"KarenB" wrote:

I got it! I just changed the following line of code from:

Txt$ =
"=IF(RC[-2]<R[-1]C[-2],INT(VLOOKUP(RC[-2],C[4]:C[5],2,FALSE)/9),IF(R[-1]C=0,0,R[-1]C-1))"

To:
Txt$ =
"=IF(RC[-2]<R[-1]C[-2],round(VLOOKUP(RC[-2],C[4]:C[5],2,FALSE)/10,0),IF(R[-1]C=0,0,R[-1]C-1))"

"KarenB" wrote:

One other thing I've noticed.... nameID(s) are only returned for locations
with at least 10 individuals. I need to ensure that at least one ID is
returned for any location that has 5 or more individuals.

Where would I make that change in your code?

"Tom Hutchins" wrote:

This is a fun problem. Here is a routine for you. It copies the sheet to a
new sheet and deletes all columns after B. As in NickHK's suggestion, it adds
a random number formula to every row of data, calcs, and converts the random
numbers to values. Then it sorts the data by location & random number. Next,
a pivot table is created on the sheet which counts the names by location. A
formula is added to every data row which counts down the requisite number of
names (already randomized) for each location. The rest of the names are
deleted.

There are a number of global variables at the top. You will need to edit
their values to match your worksheet. Hopefully, no other changes should be
needed in the code.

Global Const NameFld = "Name" 'Heading of Name field in column A
Global Const LocFld = "Loc" 'Heading of Location field in column B
Global Const StartSht = "Sheet1" 'Name of sheet with Name/Location data
Global Const NewSht = "SheetX" 'Name for the new sheet
Global Const PvtTbl = "LocPivot" 'Name for the pivot table
Global Const HdgRow = 3 'Row on StartSht which contains the headings

Sub RandomPicker()
Dim LastRow As Long, Rng As Range, Txt As String
'Delete NewSht if it already exists
On Error Resume Next
Sheets(NewSht).Delete
On Error GoTo RPerr1
'Copy StartSht as NewSht
Sheets(StartSht$).Copy Befo=Sheets(1)
ActiveSheet.Name = NewSht$
'Delete all colummns after B.
Columns("C:C").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Delete Shift:=xlToLeft
'Enter a heading and formula to generate a random number in column C.
Range("C" & HdgRow).Activate
ActiveCell.FormulaR1C1 = "rand"
Range("C" & HdgRow + 1).Activate
ActiveCell.FormulaR1C1 = "=ROUND(RAND()*10000,0)"
'Find the last row of data.
LastRow& = Range("A" & Rows.Count).End(xlUp).Row
'Copy the random number formula down through the last row.
Range("C" & HdgRow + 1).Select
Selection.AutoFill Destination:=Range("C" & HdgRow + 1 & ":C" & LastRow&)
'Recalc, then copy & paste the random numbers in place as values.
Calculate
Range("C" & HdgRow + 1 & ":C" & LastRow&).Copy
Range("C" & HdgRow + 1 & ":C" & LastRow&).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
'Assign all the data to a range variable (for convenience).
Set Rng = Range("A" & HdgRow & ":C" & LastRow&)
'Sort the data by location and random number.
Rng.Sort Key1:=Range("B" & HdgRow), Order1:=xlAscending, Key2:=Range("C"
& HdgRow), _
Order2:=xlAscending, Header:=xlYes, OrderCustom:=1,
MatchCase:=False, _
Orientation:=xlTopToBottom, DataOption1:=xlSortNormal,
DataOption2:=xlSortNormal
'Create a pivot table on the sheet counting the names by location.
ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatab ase,
SourceData:=Rng).CreatePivotTable TableDestination:= _
ActiveSheet.Cells(3, 8), TableName:="LocPivot",
DefaultVersion:=xlPivotTableVersion10
With ActiveSheet.PivotTables("LocPivot").PivotFields(Lo cFld)
.Orientation = xlRowField
.Position = 1
End With
ActiveSheet.PivotTables("LocPivot").AddDataField
ActiveSheet.PivotTables( _
"LocPivot").PivotFields(NameFld), "Count of " & NameFld, xlCount
'Copy & paste the pivot table in place as values.
Range("H3").CurrentRegion.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
'Enter a heading of 0 (zero) in column D.
Range("D" & HdgRow).Activate
ActiveCell.FormulaR1C1 = 0
'Enter a formula in column D which will count down the correct number of
names (which have already
'been randomized) for each location.
Range("D" & HdgRow + 1).Activate
Txt$ =
"=IF(RC[-2]<R[-1]C[-2],INT(VLOOKUP(RC[-2],C[4]:C[5],2,FALSE)/10),IF(R[-1]C=0,0,R[-1]C-1))"
ActiveCell.FormulaR1C1 = Txt$
'Copy the formula down through the last row of data.
Range("D" & HdgRow + 1).Select
Selection.AutoFill Destination:=Range("D" & HdgRow + 1 & ":D" & LastRow&)
'Copy & paste column D in place as values.
Range("D" & HdgRow + 1 & ":D" & LastRow&).Copy
Range("D" & HdgRow + 1 & ":D" & LastRow&).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Set Rng = Rng.Resize(, 4)
'Sort the data in ascending order by column D.
Rng.Sort Key1:=Range("D" & HdgRow), Order1:=xlAscending,
Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom,
DataOption1:=xlSortNormal
'Find the last row with a 0 in column D.
LastRow& = Application.WorksheetFunction.Match(1, Columns("D:D"), 0) - 1
'Delete all the rows with a 0 in column D (except the heading row).
Range("D" & HdgRow + 1 & ":D" & LastRow&).EntireRow.Delete
'Sort the data by location and random number.
Rng.Sort Key1:=Range("B" & HdgRow), Order1:=xlAscending, Key2:=Range("C"
& HdgRow), _
Order2:=xlAscending, Header:=xlYes, OrderCustom:=1,
MatchCase:=False, _
Orientation:=xlTopToBottom, DataOption1:=xlSortNormal,
DataOption2:=xlSortNormal
'Delete columns H & I.
ActiveSheet.Columns("H:I").Delete
'Delete columns C & D.
ActiveSheet.Columns("C:D").Delete
Cleanup1:
ActiveSheet.Range("A1").Activate
Set Rng = Nothing
Exit Sub
RPerr1:
If Err.Number < 0 Then
Txt$ = "Error # " & Str(Err.Number) & " was generated by " _
& Err.Source & Chr(13) & Err.Description
MsgBox Txt$, , "RandomPicker", Err.HelpFile, Err.HelpContext
End If
GoTo Cleanup1
End Sub

Hope this helps,

Hutch

"KarenB" wrote:

I have a list of names (2500) spread over 55 different locations.

Col A = names Col B = location

I need to create a function where I randomly select 10% of the values in
each location.

Any ideas out there?