I found the code below which randomly selects number and places them into column "I". However, I need*the code to search through column "F" and randomly select numbers from column "F" and place the result in column "I".
Any ideas most welcome???
' Select the indicated number of items from the
' currently selected cells.
Public Sub SelectRandom(ByVal num_to_select As Integer)
Dim num_items As Integer
Dim indexes() As Integer
Dim i As Integer
Dim j As Integer
Dim temp As Integer
Dim myDate As Date
myDate = Date
*** ' Make sure the selection is a range.
*** If Not (TypeOf Application.Selection Is Range) Then
******* MsgBox "The current selection is not a range."
******* Exit Sub
*** End If
*** ' Make sure selecting at least 1 item.
*** If num_to_select < 1 Then
******* MsgBox "Cannot pick fewer than 1 item."
******* Exit Sub
*** End If
*** ' See how many items are selected.
*** num_items = Application.Range("B1:B3000").Count
*** If num_to_select > num_items Then
******* MsgBox "You cannot pick more items than there are in total."
******* Exit Sub
*** End If
*** ' Make an array of this many numbers.
*** ' Add 1 because the cell indexes
*** ' in the selection start at index 1.
*** ReDim indexes(0 To num_items - 1)
*** For i = 0 To num_items - 1
******* indexes(i) = i + 1
*** Next i
***
*** ' Randomize the numbers.
*** For i = num_items - 1 To 1 Step -1
******* ' Randomly pick an index at or below this one.
******* j = Int((i + 1) * Rnd)
*******
******* ' Swap indexes(j) and indexes(i).
******* temp = indexes(i)
******* indexes(i) = indexes(j)
******* indexes(j) = temp
*** Next i
***
*** ' Deselect all items.
*** Application.Selection.Font.Bold = False
*** Application.Selection.Font.Color = vbBlack
*** ' Select the first items.
*** For i = 0 To num_to_select - 1
*******
******* 'Application.Selection.Cells(indexes(i)).Font.Color = vbRed
******* Range("I" & Rows.Count).End(xlUp).Offset(1, 0).Value = indexes(i)
******* Range("I" & Rows.Count).End(xlUp).Offset(0, 1).Value = Date
*** Next i
End Sub
Bookmarks