Get Random Selection

[joand]

In Column A, I have a list of Item Types, e.g. Item 1, Item 2, Item 3 in unsorted order. I need to randomly select 5% from each Item type and output the randomly selected items in column B. Is there a simpler way to do this?

 

[SteveO59L]

approx how many values?

 

[joand]

Here's an illustration. In column A are the item types. In Column B are the specific/unique item codes. I would like to output the random selection in column C. Since item 1, item 2 and item 3 have 20 counts each. 5% of each is 1, which means I need to select 1 from each item type randomly.

Column A Column B Column C
Item 1 Train 1 Train 3
Item 1 Train 2 Car 1
Item 1 Train 3 Boat 11
Item 1 Train 4
Item 1 Train 5
Item 1 Train 6
Item 1 Train 7
Item 1 Train 8
Item 1 Train 9
Item 1 Train 10
Item 1 Train 11
Item 1 Train 12
Item 1 Train 13
Item 1 Train 14
Item 1 Train 15
Item 1 Train 16
Item 1 Train 17
Item 1 Train 18
Item 1 Train 19
Item 1 Train 20
Item 2 Car 1
Item 2 Car 2
Item 2 Car 3
Item 2 Car 4
Item 2 Car 5
Item 2 Car 6
Item 2 Car 7
Item 2 Car 8
Item 2 Car 9
Item 2 Car 10
Item 2 Car 11
Item 2 Car 12
Item 2 Car 13
Item 2 Car 14
Item 2 Car 15
Item 2 Car 16
Item 2 Car 17
Item 2 Car 18
Item 2 Car 19
Item 2 Car 20
Item 3 Boat 1
Item 3 Boat 2
Item 3 Boat 3
Item 3 Boat 4
Item 3 Boat 5
Item 3 Boat 6
Item 3 Boat 7
Item 3 Boat 8
Item 3 Boat 9
Item 3 Boat 10
Item 3 Boat 11
Item 3 Boat 12
Item 3 Boat 13
Item 3 Boat 14
Item 3 Boat 15
Item 3 Boat 16
Item 3 Boat 17
Item 3 Boat 18
Item 3 Boat 19
Item 3 Boat 20

 

[joand]

There are many values, probably more than 1 thousand values.

 

[ranman256]

paste this code into a module

Public Sub Random5Pct()
Dim colNames As New Collection
Dim i As Integer, iCnt As Integer, iNum As Integer, iCol As Integer
Dim vPicks
Const kPICKpct = 5


On Error GoTo errRand


     'load the collection
Sheets("names2").Select
Range("A2").Select
While ActiveCell.Value <> ""
   colNames.Add ActiveCell.Value
   ActiveCell.Offset(1, 0).Select   'next row
Wend


    'get the % to randomize
vPicks = kPICKpct / 100 * colNames.Count


'Sheets.Add
 Range("B1").Value = "Picks"
 Range("B2").Select


    For i = 1 To vPicks
      iCnt = colNames.Count
      'iNum = Int(iCnt * Rnd) + 1
      iNum = Int(1 + Rnd() * (iCnt - 1 + 1))
      
      ActiveCell.Value = colNames(iNum)
      colNames.Remove iNum
      
       ActiveCell.Offset(1, 0).Select   'next row
    Next
   
set colNames = nothing
errRand:
End Sub

 

[joand]

Thank you for the code