I am a supporter of
St. Joseph's hospice.
 If you find this site useful or if it helped you, consider a small donation to
St. Joseph's, please.

Information on
St. Joseph's

If your selection of cells should determine how many cells you randomly want to pick, take this function, please.

Please notice that you also need my UDF VBUniqRandInt (it is called by this function).

Function Random_Pick(ParamArray vrng() _
                As Variant) As Variant
'Returns n random cell contents of multi-range input
'[paramarray can be A1:C3, D7:IV88, for example] if n
'cells in a worksheet have been selected and the function
'has been entered as array formula (CTRL+SHIFT+ENTER).
'Reverse("moc.liborplus.www") V0.1 PB 19-Sep-2010
Dim vR As Variant, vi As Variant
Dim i As Long, j As Long
Dim lrow As Long, lcol As Long
Dim lpari As Long, lRange As Long

If TypeName(Application.Caller) <> "Range" Then
   Random_Pick = CVErr(xlErrRef)
   Exit Function
End If

ReDim vR(1 To Application.Caller.Rows.Count, _
            1 To Application.Caller.Columns.Count)
ReDim lparidx(LBound(vrng) To UBound(vrng)) As Long

'Store range counts and sum them up
lRange = 0
For i = LBound(vrng) To UBound(vrng)
    lRange = lRange + vrng(i).Count
    lparidx(i) = vrng(i).Count
Next i

If Application.Caller.Count > lRange Then
   Random_Pick = CVErr(xlErrValue)
   Exit Function
End If

lrow = 1
lcol = 1
For Each vi In VBUniqRandInt( _
        Application.Caller.Count, lRange)
    j = vi
    lpari = LBound(lparidx)
    Do While j > lparidx(lpari)
        j = j - lparidx(lpari)
        lpari = lpari + 1
    Loop
    vR(lrow, lcol) = vrng(lpari)(j)
    lcol = lcol + 1
    If lcol > UBound(vR, 2) Then
        lrow = lrow + 1
        lcol = 1
    End If
Next vi

Random_Pick = vR

End Function

Here is a version to call from within VBA:

Function VBRandom_Pick(lCount As Long, ParamArray vrng() _
                As Variant) As Variant
'Returns lCount random cell contents of multi-range input
'[paramarray can be A1:C3, D7:IV88, for example]
'Reverse("moc.liborplus.www") V0.1 PB 26-Aug-2012
Dim vR As Variant, vi As Variant
Dim i As Long, j As Long
Dim lrow As Long
Dim lpari As Long, lRange As Long

ReDim vR(1 To lCount)
ReDim lparidx(LBound(vrng) To UBound(vrng)) As Long

'Store range counts and sum them up
lRange = 0
For i = LBound(vrng) To UBound(vrng)
    lRange = lRange + vrng(i).Count
    lparidx(i) = vrng(i).Count
Next i

If lCount > lRange Then
   VBRandom_Pick = CVErr(xlErrValue)
   Exit Function
End If

lrow = 1
For Each vi In VBUniqRandInt(lCount, lRange)
    j = vi
    lpari = LBound(lparidx)
    Do While j > lparidx(lpari)
        j = j - lparidx(lpari)
        lpari = lpari + 1
    Loop
    vR(lrow) = vrng(lpari)(j)
    lrow = lrow + 1
Next vi

VBRandom_Pick = Application.WorksheetFunction.Transpose(vR)

End Function