I need a Value Picker function

[KarenB]

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?

[RB Smissaert]

I would start by putting the data in a 2-D array, where the array
columns are the different locations and the array rows the different names.
This has the advantage that all the name rows go from 1 (or 0 if you want an
0-based array)
to whatever maximum, making it easier to use the Rand function.
Then all you have to do is loop through the columns (the locations) and
randomly pick
names from those columns, moving to the next column when you have picked 10%
of the column.
I am not sure if you have to randomly through the locations, but that is
problem either as the columns
have a fixed start and end as well.
The added benefit (although small as your numbers are small) is that working
with an array is faster than
working with sheet ranges.

RBS

"KarenB" <[email protected]> wrote in message
news:[email protected]...
>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?

[KarenB]

I probably should have mentioned that my worksheet, although it contains
those 2 columns (IDname, location), it also has a great deal of additional
information (20 columns total) specific to the IDname, so the 2-D array is
not feasible.

"RB Smissaert" wrote:

> I would start by putting the data in a 2-D array, where the array
> columns are the different locations and the array rows the different names.
> This has the advantage that all the name rows go from 1 (or 0 if you want an
> 0-based array)
> to whatever maximum, making it easier to use the Rand function.
> Then all you have to do is loop through the columns (the locations) and
> randomly pick
> names from those columns, moving to the next column when you have picked 10%
> of the column.
> I am not sure if you have to randomly through the locations, but that is
> problem either as the columns
> have a fixed start and end as well.
> The added benefit (although small as your numbers are small) is that working
> with an array is faster than
> working with sheet ranges.
>
> RBS
>
> "KarenB" <[email protected]> wrote in message
> news:[email protected]...
> >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?
>
>

[RB Smissaert]

How about a 3-D array then?
Maybe you should describe the layout of the data in the sheet.

RBS

"KarenB" <[email protected]> wrote in message
news:[email protected]...
>I probably should have mentioned that my worksheet, although it contains
> those 2 columns (IDname, location), it also has a great deal of additional
> information (20 columns total) specific to the IDname, so the 2-D array is
> not feasible.
>
> "RB Smissaert" wrote:
>
>> I would start by putting the data in a 2-D array, where the array
>> columns are the different locations and the array rows the different
>> names.
>> This has the advantage that all the name rows go from 1 (or 0 if you want
>> an
>> 0-based array)
>> to whatever maximum, making it easier to use the Rand function.
>> Then all you have to do is loop through the columns (the locations) and
>> randomly pick
>> names from those columns, moving to the next column when you have picked
>> 10%
>> of the column.
>> I am not sure if you have to randomly through the locations, but that is
>> problem either as the columns
>> have a fixed start and end as well.
>> The added benefit (although small as your numbers are small) is that
>> working
>> with an array is faster than
>> working with sheet ranges.
>>
>> RBS
>>
>> "KarenB" <[email protected]> wrote in message
>> news:[email protected]...
>> >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?
>>
>>

[KarenB]

I have 20 columns. The first column lists the individual IDs, the second
lists the individual's name, then location, department, cost center, ***,
email, and so on, and so on. From this list, I need to extract (preferrably
randomly) 10% of the ID numbers, within each location. So, for location #1,
I need 12 of the 120 ID's, location #2 I need 7 of the 74 ID's, and so on.

Those ID's will then be stored on a separate worksheet and will be used in
vLookup formulas to reference back to the original (to get the individual's
name, email address, etc).


"RB Smissaert" wrote:

> How about a 3-D array then?
> Maybe you should describe the layout of the data in the sheet.
>
> RBS
>
> "KarenB" <[email protected]> wrote in message
> news:[email protected]...
> >I probably should have mentioned that my worksheet, although it contains
> > those 2 columns (IDname, location), it also has a great deal of additional
> > information (20 columns total) specific to the IDname, so the 2-D array is
> > not feasible.
> >
> > "RB Smissaert" wrote:
> >
> >> I would start by putting the data in a 2-D array, where the array
> >> columns are the different locations and the array rows the different
> >> names.
> >> This has the advantage that all the name rows go from 1 (or 0 if you want
> >> an
> >> 0-based array)
> >> to whatever maximum, making it easier to use the Rand function.
> >> Then all you have to do is loop through the columns (the locations) and
> >> randomly pick
> >> names from those columns, moving to the next column when you have picked
> >> 10%
> >> of the column.
> >> I am not sure if you have to randomly through the locations, but that is
> >> problem either as the columns
> >> have a fixed start and end as well.
> >> The added benefit (although small as your numbers are small) is that
> >> working
> >> with an array is faster than
> >> working with sheet ranges.
> >>
> >> RBS
> >>
> >> "KarenB" <[email protected]> wrote in message
> >> news:[email protected]...
> >> >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?
> >>
> >>
>
>

[RB Smissaert]

OK, run a Do While loop till a counter reaches a certain number.
This counter will keep track of all the successfull finds in any location.
A successful find is a random pick of the column Location where the Location
count for the found
location is still below the 10% of the total count of that location.
When there is a successfull find pick up the ID number and either put it in
an array or put it directly in
that other sheet.
So you also need to keep track of all the different finds for the different
locations and this is easiest
done with a 1-D array.
Lookup the Rand function in the help if you don't know it.

RBS


"KarenB" <[email protected]> wrote in message
news:[email protected]...
>I have 20 columns. The first column lists the individual IDs, the second
> lists the individual's name, then location, department, cost center, ***,
> email, and so on, and so on. From this list, I need to extract
> (preferrably
> randomly) 10% of the ID numbers, within each location. So, for location
> #1,
> I need 12 of the 120 ID's, location #2 I need 7 of the 74 ID's, and so on.
>
> Those ID's will then be stored on a separate worksheet and will be used in
> vLookup formulas to reference back to the original (to get the
> individual's
> name, email address, etc).
>
>
> "RB Smissaert" wrote:
>
>> How about a 3-D array then?
>> Maybe you should describe the layout of the data in the sheet.
>>
>> RBS
>>
>> "KarenB" <[email protected]> wrote in message
>> news:[email protected]...
>> >I probably should have mentioned that my worksheet, although it contains
>> > those 2 columns (IDname, location), it also has a great deal of
>> > additional
>> > information (20 columns total) specific to the IDname, so the 2-D array
>> > is
>> > not feasible.
>> >
>> > "RB Smissaert" wrote:
>> >
>> >> I would start by putting the data in a 2-D array, where the array
>> >> columns are the different locations and the array rows the different
>> >> names.
>> >> This has the advantage that all the name rows go from 1 (or 0 if you
>> >> want
>> >> an
>> >> 0-based array)
>> >> to whatever maximum, making it easier to use the Rand function.
>> >> Then all you have to do is loop through the columns (the locations)
>> >> and
>> >> randomly pick
>> >> names from those columns, moving to the next column when you have
>> >> picked
>> >> 10%
>> >> of the column.
>> >> I am not sure if you have to randomly through the locations, but that
>> >> is
>> >> problem either as the columns
>> >> have a fixed start and end as well.
>> >> The added benefit (although small as your numbers are small) is that
>> >> working
>> >> with an array is faster than
>> >> working with sheet ranges.
>> >>
>> >> RBS
>> >>
>> >> "KarenB" <[email protected]> wrote in message
>> >> news:[email protected]...
>> >> >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?
>> >>
>> >>
>>
>>

[NickHK]

Karen,
You can add a column with =Rnd(), then sort by that column, taking the top
10% of rows [which= Int(.CurrentRegion.Rows/10)]
If can't/don't want to sort the original data, create a table of your IDs (I
assume are unique) and =Rnd() column, sort and use the ID values and VLookUp
to get the Name and/or location.
As Rnd is volatile, you will get a different ordering each time.

NickHK

"KarenB" <[email protected]> wrote in message
news:[email protected]...
> 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?

[KarenB]

Thanks Nick... but that still doesn't take into account the fact that there
are 55 locations (stored in a separate column), and I need 10% of each of
those locations.

"NickHK" wrote:

> Karen,
> You can add a column with =Rnd(), then sort by that column, taking the top
> 10% of rows [which= Int(.CurrentRegion.Rows/10)]
> If can't/don't want to sort the original data, create a table of your IDs (I
> assume are unique) and =Rnd() column, sort and use the ID values and VLookUp
> to get the Name and/or location.
> As Rnd is volatile, you will get a different ordering each time.
>
> NickHK
>
> "KarenB" <[email protected]> wrote in message
> news:[email protected]...
> > 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?
>
>
>

[RB Smissaert]

How about my last suggestion?
I think that will work.

RBS

"KarenB" <[email protected]> wrote in message
news:[email protected]...
> Thanks Nick... but that still doesn't take into account the fact that
> there
> are 55 locations (stored in a separate column), and I need 10% of each of
> those locations.
>
> "NickHK" wrote:
>
>> Karen,
>> You can add a column with =Rnd(), then sort by that column, taking the
>> top
>> 10% of rows [which= Int(.CurrentRegion.Rows/10)]
>> If can't/don't want to sort the original data, create a table of your IDs
>> (I
>> assume are unique) and =Rnd() column, sort and use the ID values and
>> VLookUp
>> to get the Name and/or location.
>> As Rnd is volatile, you will get a different ordering each time.
>>
>> NickHK
>>
>> "KarenB" <[email protected]> wrote in message
>> news:[email protected]...
>> > 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?
>>
>>
>>

[Tom Hutchins]

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 Before:=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:=xlDatabase,
SourceData:=Rng).CreatePivotTable TableDestination:= _
ActiveSheet.Cells(3, 8), TableName:="LocPivot",
DefaultVersion:=xlPivotTableVersion10
With ActiveSheet.PivotTables("LocPivot").PivotFields(LocFld)
.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?

[KarenB]

Thanks RBS and Hutch for your responses. RBS: I was still working on the
code for your solution when I saw Hutch's response, but I wasn't at a point
where it was functional....

Hutch, I really appreciate you putting in the time to develop the code...
but unfortunately, it does through an error. I stepped through and it
appears that the error:
"Error#450 was generated by VBAProject. Wrong number of arguments or
invalid property assignment."
is a result of this line:
"ActiveSheet.PivotTables("LocPivot").AddDataField"

I'll keep looking, but if you have a minute and the problem/solution is
obvious to you, let me know.

Thanks again to both of you!

Karen

"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 Before:=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:=xlDatabase,
> SourceData:=Rng).CreatePivotTable TableDestination:= _
> ActiveSheet.Cells(3, 8), TableName:="LocPivot",
> DefaultVersion:=xlPivotTableVersion10
> With ActiveSheet.PivotTables("LocPivot").PivotFields(LocFld)
> .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?

[KarenB]

I wrote my last post a little too quickly. I found the problem (one line of
code had separated into two lines when I pasted it.)

Thanks again for all your help. It works like a charm!

Karen

"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 Before:=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:=xlDatabase,
> SourceData:=Rng).CreatePivotTable TableDestination:= _
> ActiveSheet.Cells(3, 8), TableName:="LocPivot",
> DefaultVersion:=xlPivotTableVersion10
> With ActiveSheet.PivotTables("LocPivot").PivotFields(LocFld)
> .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?

[KarenB]

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 Before:=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:=xlDatabase,
> SourceData:=Rng).CreatePivotTable TableDestination:= _
> ActiveSheet.Cells(3, 8), TableName:="LocPivot",
> DefaultVersion:=xlPivotTableVersion10
> With ActiveSheet.PivotTables("LocPivot").PivotFields(LocFld)
> .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?

[KarenB]

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 Before:=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:=xlDatabase,
> > SourceData:=Rng).CreatePivotTable TableDestination:= _
> > ActiveSheet.Cells(3, 8), TableName:="LocPivot",
> > DefaultVersion:=xlPivotTableVersion10
> > With ActiveSheet.PivotTables("LocPivot").PivotFields(LocFld)
> > .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?

[KarenB]

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 Before:=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:=xlDatabase,
> > SourceData:=Rng).CreatePivotTable TableDestination:= _
> > ActiveSheet.Cells(3, 8), TableName:="LocPivot",
> > DefaultVersion:=xlPivotTableVersion10
> > With ActiveSheet.PivotTables("LocPivot").PivotFields(LocFld)
> > .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?

[KarenB]

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 Before:=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:=xlDatabase,
> > SourceData:=Rng).CreatePivotTable TableDestination:= _
> > ActiveSheet.Cells(3, 8), TableName:="LocPivot",
> > DefaultVersion:=xlPivotTableVersion10
> > With ActiveSheet.PivotTables("LocPivot").PivotFields(LocFld)
> > .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?

[KarenB]

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 Before:=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:=xlDatabase,
> > SourceData:=Rng).CreatePivotTable TableDestination:= _
> > ActiveSheet.Cells(3, 8), TableName:="LocPivot",
> > DefaultVersion:=xlPivotTableVersion10
> > With ActiveSheet.PivotTables("LocPivot").PivotFields(LocFld)
> > .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?

[Tom Hutchins]

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 Before:=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:=xlDatabase,
> > > SourceData:=Rng).CreatePivotTable TableDestination:= _
> > > ActiveSheet.Cells(3, 8), TableName:="LocPivot",
> > > DefaultVersion:=xlPivotTableVersion10
> > > With ActiveSheet.PivotTables("LocPivot").PivotFields(LocFld)
> > > .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?