Random formula for two variables

I have a database that contains among everything else...a list of items numbers and a list of associate names aligned to those item numbers. I am trying to take a sample of 2 items that each associate produced. So in theory, if Sally produced 10 items (Items: 1001, 1203, 4503, 4542, 4555, 5555, 5612, 6564, 8832, 9222) and I wanted to randomly pull 2 of those items out based on just Sally's name (among all my list of associates), how can I formulate a formula to do so? Anyone? Thanks!


Josh

Those 10 are in my company's data source every morning.

The CHOOSE formula would only provide for a select number (2 in this case) for just Sally, right? But what if I needed to go each associate by each associate and there are 1000 associates that I need to pull 2 from?

So, if you look at the attachment. I need to randomly choose 2 Item Numbers for Janell Abraham, 2 for Angelina Acosta, 2 for Mark Adler...so on and so on...

Any suggestions?

Thanks!

Josh

This assumes you have NAME, item1, item2, ...
Alter as you wish.

Sub RandomList()
Dim vName
Dim r As Integer, c As Integer, j As Integer
Dim col As Collection
Dim shtApp As Worksheet, shtOut As Worksheet
Const kKEEP = 2

Set shtApp = ActiveSheet
Worksheets.Add
Set shtOut = ActiveSheet
shtApp.Activate

Range("A2").Select
While ActiveCell.Value <> ""
   vName = ActiveCell.Value
  shtOut.Activate
  ActiveCell.Value = vName
  shtApp.Activate
    
  c = 1
  Set col = New Collection
                        'get all values into collection
  While ActiveCell.Offset(0, c).Value <> ""
     col.Add ActiveCell.Offset(0, c).Value
     c = c + 1
  Wend
   
                    'sift thru collection for randoms
  shtOut.Activate
  j = 1
  If col.Count > kKEEP Then
      c = col.Count
      For i = 1 To kKEEP
         r = Int((c - 2 + 1) * Rnd() + 2)  'start at 2nd item,1st is name
             'put 1 item random
         ActiveCell.Offset(0, j).Value = col(c)
         j = j + 1
             
            'remove item
         col.Remove r
         c = c - 1
      Next
  Else
     For c = 1 To col.Count                                    'put all the items
         ActiveCell.Offset(0, c).Value = col(c)
     Next
  End If
  ActiveCell.Offset(1, 0).Select   'next row
  shtApp.Activate
 
   ActiveCell.Offset(1, 0).Select   'next row
Wend

Set col = Nothing
Set shtApp = Nothing
Set shtOut = Nothing
End Sub