I am a supporter ofSt. Joseph's hospice. If you find this site useful or if it helped you, consider a small donation toSt. Joseph's, please. Information onSt. 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-2010Dim vR As Variant, vi As VariantDim i As Long, j As LongDim lrow As Long, lcol As LongDim lpari As Long, lRange As LongIf TypeName(Application.Caller) <> "Range" Then   Random_Pick = CVErr(xlErrRef)   Exit FunctionEnd IfReDim 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 uplRange = 0For i = LBound(vrng) To UBound(vrng)    lRange = lRange + vrng(i).Count    lparidx(i) = vrng(i).CountNext iIf Application.Caller.Count > lRange Then   Random_Pick = CVErr(xlErrValue)   Exit FunctionEnd Iflrow = 1lcol = 1For 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 IfNext viRandom_Pick = vREnd 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-2012Dim vR As Variant, vi As VariantDim i As Long, j As LongDim lrow As LongDim lpari As Long, lRange As LongReDim vR(1 To lCount)ReDim lparidx(LBound(vrng) To UBound(vrng)) As Long'Store range counts and sum them uplRange = 0For i = LBound(vrng) To UBound(vrng)    lRange = lRange + vrng(i).Count    lparidx(i) = vrng(i).CountNext iIf lCount > lRange Then   VBRandom_Pick = CVErr(xlErrValue)   Exit FunctionEnd Iflrow = 1For 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 + 1Next viVBRandom_Pick = Application.WorksheetFunction.Transpose(vR)End Function