VBA to Select values in random cells and paste to sheet 2

[Human_doing]

Hi all,

I have a workbook that has a list of numbers in column A. Can anyone please assist with the VBA to do the following:

1. Bring up a message box asking how many random cells should be selected.

2. Select the requested number of random cells.

3. Copy to column A on sheet 2.

It would be beneficial if a cell could only be selected once i.e. to avoid the random selection of duplicates,

Thanks in advance for any help!

 

[jerry12302]

Try this code, modify range locations as necessary

<font face=Courier New><SPAN style="color:#00007F">Sub</SPAN> Macro1()<br>    <SPAN style="color:#007F00">'Macro assumptions:</SPAN><br>    <SPAN style="color:#007F00">'Sheet1 contains random numbers in column A.  May contain text or blank cells also.</SPAN><br>    <SPAN style="color:#007F00">'Columns B and C in Sheet1 are available for temporary use by the macro, and do not contain data</SPAN><br>    <SPAN style="color:#007F00">'Data will be inserted into Sheet2 in column A</SPAN><br>    <SPAN style="color:#00007F">Dim</SPAN> CountCells<br>    <SPAN style="color:#00007F">Dim</SPAN> RandCount<br>    <SPAN style="color:#00007F">Dim</SPAN> LastRow<br>    <SPAN style="color:#00007F">Dim</SPAN> Counter1<br>    <SPAN style="color:#00007F">Dim</SPAN> Counter2<br>    Worksheets("Sheet1").Select<br>    Range("A1").Select<br>    CountCells = WorksheetFunction.Count(Range("A:A")) <SPAN style="color:#007F00">'quantity of random numbers to pick from</SPAN><br>    <SPAN style="color:#00007F">If</SPAN> CountCells = 0 <SPAN style="color:#00007F">Then</SPAN> <SPAN style="color:#00007F">Exit</SPAN> <SPAN style="color:#00007F">Sub</SPAN><br>    <SPAN style="color:#00007F">On</SPAN> <SPAN style="color:#00007F">Error</SPAN> <SPAN style="color:#00007F">Resume</SPAN> <SPAN style="color:#00007F">Next</SPAN><br>    Application.DisplayAlerts = <SPAN style="color:#00007F">False</SPAN><br>    RandCount = Application.InputBox(Prompt:="How many random numbers do you want?", _<br>          Title:="Random Numbers Selection", Type:=1)<br>    <SPAN style="color:#00007F">On</SPAN> <SPAN style="color:#00007F">Error</SPAN> <SPAN style="color:#00007F">GoTo</SPAN> 0<br>    Application.DisplayAlerts = <SPAN style="color:#00007F">True</SPAN><br>    RandCount = Int(RandCount)<br>    <SPAN style="color:#00007F">If</SPAN> Int(RandCount) <= 0 <SPAN style="color:#00007F">Or</SPAN> RandCount = <SPAN style="color:#00007F">False</SPAN> <SPAN style="color:#00007F">Then</SPAN> <SPAN style="color:#00007F">Exit</SPAN> <SPAN style="color:#00007F">Sub</SPAN><br>    <SPAN style="color:#00007F">If</SPAN> RandCount > CountCells <SPAN style="color:#00007F">Then</SPAN><br>        MsgBox "Requested quantity of numbers is greater than quantity of available data"<br>        <SPAN style="color:#00007F">Exit</SPAN> <SPAN style="color:#00007F">Sub</SPAN><br>    <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN><br>    LastRow = Cells(Rows.Count, "A").End(xlUp).Row<br>    <SPAN style="color:#007F00">'clear working area</SPAN><br>    Range("B:C").ClearContents<br>    <SPAN style="color:#007F00">'clear destination area</SPAN><br>    Range("Sheet2!A:A").ClearContents<br>    <SPAN style="color:#007F00">'create index for sort use</SPAN><br>    Range("B1") = 1<br>    Range(Cells(1, 2), Cells(LastRow, 2)).DataSeries , Step:=1<br>    <SPAN style="color:#007F00">'create random numbers for sort</SPAN><br>    Range("C1") = "=RAND()"<br>    Range("C1").Copy Range(Cells(1, 3), Cells(LastRow, 3))<br>    <SPAN style="color:#007F00">'randomly sort data</SPAN><br>    Range(Cells(1, 1), Cells(LastRow, 3)).Sort Key1:=Range("C1"), Order1:=xlAscending, Header:=xlGuess, _<br>        Orientation:=xlTopToBottom, DataOption1:=xlSortNormal<br>    <SPAN style="color:#007F00">'data has been sorted randomly, cells in column A, rows 1 through the quantity desired will be chosen</SPAN><br>    Counter1 = 1<br>    Counter2 = 1<br>    <SPAN style="color:#00007F">Do</SPAN> <SPAN style="color:#00007F">Until</SPAN> Counter1 > RandCount<br>        <SPAN style="color:#00007F">If</SPAN> IsNumeric(Cells(Counter2, 1).Value) And Cells(Counter2, 1).Value <> <SPAN style="color:#00007F">Empty</SPAN> <SPAN style="color:#00007F">Then</SPAN><br>            Range("Sheet2!A" & Counter1) = Cells(Counter2, 1).Value<br>            Counter1 = Counter1 + 1<br>        <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN><br>        Counter2 = Counter2 + 1<br>    <SPAN style="color:#00007F">Loop</SPAN><br>    <SPAN style="color:#007F00">'resort data into original order and clear working area</SPAN><br>    Range(Cells(1, 1), Cells(LastRow, 3)).Sort Key1:=Range("B1"), Order1:=xlAscending, Header:=xlGuess, _<br>        Orientation:=xlTopToBottom, DataOption1:=xlSortNormal<br>    Range("B:C").ClearContents<br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN></FONT>

 

[kiransakaray]

Hello Jerry, I have same kind of data with random selection from Cells B1:B1000, I got the solution with the above macro, But..
1. I have names in Column A1:A1000, 5 names repeated (For example, Kiran, John, Den, Roy, and Leo). I may get more than 5 names.
2. When the message box “How many random numbers do you want?" display I will enter number 10, I want 2 numbers equally selected from the all 5 names.
3. Loop can start from the 1^st name to last name.

 

[jerry12302]

Hello Jerry, I have same kind of data with random selection from Cells B1:B1000, I got the solution with the above macro, But..
1. I have names in Column A1:A1000, 5 names repeated (For example, Kiran, John, Den, Roy, and Leo). I may get more than 5 names.
2. When the message box “How many random numbers do you want?" display I will enter number 10, I want 2 numbers equally selected from the all 5 names.
3. Loop can start from the 1^st name to last name.

Hi, I would be happy to help you with this...

I will review, since it's been awhile, and get back to you soon.

Regards,

Jerry

 

[jerry12302]

Do you want the list of 5 names in sheet B in column A, then the first random number selection in column B, and the second random number selection in column C?

If there are more than 5 unique names, do you want every unique name listed in sheet B, column A?

If you select 20, for example, and there are 5 names, I would presume you would want 4 numbers for each of the 5 names. The macro would have to calculate based on the number of unique names, perhaps it would be better to ask for how many numbers you want for each name instead.

 

[kiransakaray]

In Column A, 5 to N number of names.
In Column B, n number of numbers for each name.

Once i input the number of random numbers wanted in message box, i was the random numbers to be picked from each name.

example:5 names Ajay, Kiran, Leo, John, and Dominic names in Column A, I want the random numbers to pick is 7, first the loop has to start from Ajay and ends with Dominic.
The random numbers result should be
Ajay - 2 Random numbers
Kiran - 2 random numbers
Leo - 1 random number
John - 1 Random Number
Dominic - 1 Random number

Please help me in this.

 

[Jusciusr]

Try this code, modify range locations as necessary

Sub Macro1()
****'Macro assumptions:
****'Sheet1 contains random numbers in column A.**May contain text or blank cells also.
****'Columns B and C in Sheet1 are available for temporary use by the macro, and do not contain data
****'Data will be inserted into Sheet2 in column A
****Dim CountCells
****Dim RandCount
****Dim LastRow
****Dim Counter1
****Dim Counter2
****Worksheets("Sheet1").Select
****Range("A1").Select
****CountCells = WorksheetFunction.Count(Range("A:A")) 'quantity of random numbers to pick from
****If CountCells = 0 Then Exit Sub
****On Error Resume Next
****Application.DisplayAlerts = False
****RandCount = Application.InputBox(Prompt:="How many random numbers do you want?", _
**********Title:="Random Numbers Selection", Type:=1)
****On Error GoTo 0
****Application.DisplayAlerts = True
****RandCount = Int(RandCount)
****If Int(RandCount) <= 0 Or RandCount = False Then Exit Sub
****If RandCount > CountCells Then
********MsgBox "Requested quantity of numbers is greater than quantity of available data"
********Exit Sub
****End If
****LastRow = Cells(Rows.Count, "A").End(xlUp).Row
****'clear working area
****Range("B:C").ClearContents
****'clear destination area
****Range("Sheet2!A:A").ClearContents
****'create index for sort use
****Range("B1") = 1
****Range(Cells(1, 2), Cells(LastRow, 2)).DataSeries , Step:=1
****'create random numbers for sort
****Range("C1") = "=RAND()"
****Range("C1").Copy Range(Cells(1, 3), Cells(LastRow, 3))
****'randomly sort data
****Range(Cells(1, 1), Cells(LastRow, 3)).Sort Key1:=Range("C1"), Order1:=xlAscending, Header:=xlGuess, _
********Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
****'data has been sorted randomly, cells in column A, rows 1 through the quantity desired will be chosen
****Counter1 = 1
****Counter2 = 1
****Do Until Counter1 > RandCount
********If IsNumeric(Cells(Counter2, 1).Value) And Cells(Counter2, 1).Value <> Empty Then
************Range("Sheet2!A" & Counter1) = Cells(Counter2, 1).Value
************Counter1 = Counter1 + 1
********End If
********Counter2 = Counter2 + 1
****Loop
****'resort data into original order and clear working area
****Range(Cells(1, 1), Cells(LastRow, 3)).Sort Key1:=Range("B1"), Order1:=xlAscending, Header:=xlGuess, _
********Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
****Range("B:C").ClearContents
End Sub

hello,
I am also looking for a similar solution. I need the code to paste in sheet2 Column A my specified number of random cells from sheet1 column A.

Would you be able to help me out with this? Also with your current code I get error "400".

 

[kiransakaray]

Any solution on my previous question, please help me out on this...