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

Human_doing

Board Regular
Joined
Feb 16, 2011
Messages
137
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!
 

Excel Facts

Excel motto
Not everything I do at work revolves around Excel. Only the fun parts.
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>
 
Upvote 0
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 1st name to last name.
 
Upvote 0
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 1st 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
 
Upvote 0
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.
 
Upvote 0
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.
 
Upvote 0
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".
 
Last edited:
Upvote 0

Forum statistics

Threads
1,213,534
Messages
6,114,186
Members
448,554
Latest member
Gleisner2

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top