Dear all, thanks in advance for looking at this thread..
I have found the following macro that randomly select an amount of cells based on a popup window that ask you how many cells you need to randomly get and copy the values into another column. So basically given a Column A with a series of numbers (there might be even empty cells in the middle), you run the macro and you are requested to provide the number of cells you want to be copied, the macro make some calculation and work on Columns B and C and copy the values randomly in Column D.
Said that.. my question is.. would it be possible to replace the number you request to have a copy with a percentage request? (e.g. instead of copy 15 numbers out 100, copy the 10% or 20% or whichever% out of 100) bear always in mind that within all the column A there might be some empty cells too which of course needs to be NOT calculated by the percentage..
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("D:D").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("D" & 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
Moderator Note:
Pls use code tags around your code as per forum rules.
Bookmarks