Randbetween data from message box entry

[ffionnah]

Hi all,
I have a macro that reads through a bunch of data and identifies unique names based on certain criteria.
Once this is completed, I have a message pop up that tells the user the total number of unique names and another message pops up identifying 25% of that total. We need to identify random numbers within this total, up to the 25%.


I would like for a macro to have a pop up, asking the user for that information, (or just pull it directly from the previous macro), and then identify and paste Randbetween numbers in the ActiveCell up to the 25% total. (can it paste123??)


Let's say there are 500 unique names. 25% of that is 125. I would like the macro to find 125 random numbers, between 1 and 500, and paste them in the ActiveCell.

Is this possible? If not, can this be broken into separate macros?

 

[ffionnah]

This doesn't seem to be working. It only provides 1 number in the ActiveCell... what am i missing?!

Sub Worksheet_Calculate()
 i = 1
        Do Until i > 129
        Range(ActiveCell, ActiveCell.Offset(0, 0)).Value = WorksheetFunction.RandBetween(1, 500)
        i = i + 1
    Loop
    
End Sub

 

[mse330]

The above code is basiclly overwriting the number of in the active cell. Just press F8 to debug the code & you will see that it places the first random number, then the loop generates another number which is overwritten in the same cell.

This code below will copy all the numbers in a row

Sub Worksheet_Calculate()
 i = 1
   Do Until i > 10
        ActiveCell.Offset(i, 0) = WorksheetFunction.RandBetween(1, 500)
        i = i + 1
    Loop
End Sub

Or if you want all the numbers to be in the same cell separated by a comma

Sub Worksheet_Calculate()
 i = 1
   Do Until i > 10
        ActiveCell = ActiveCell.Value & Comma & WorksheetFunction.RandBetween(1, 500)
        Comma = ","
        i = i + 1
    Loop
End Sub

 

[ffionnah]

Ha! I threw some different things together and figured it out! I'm sure there is a better way to do this.. If you know of it, please enlighten me!

In case anyone else needs something similar, here is my code:

 Sub RandPT()
    Dim PT As Double
    Dim num As Double
    Dim RandPT As Double
    i = 1


    PT = InputBox("Enter The Total Unique Names", "Enter a Number")
    num = InputBox("Enter The 25% ", "Enter a Number")
    RandPT = PT * num


Dim LowNo As Long, c As Range
Dim HighNo As Long
Dim Amount As Long
LowNo = 1
HighNo = PT
Amount = num
Dim FillRange As Range
Set FillRange = Range("AQ107").Resize(Amount)
For Each c In FillRange
Do
c.Value = Int((HighNo * rnd) + LowNo)
Loop Until WorksheetFunction.CountIf(FillRange, c.Value) < 2
Next
End Sub

 

[mse330]

You don't need to put 2 loops "For Each" & "Do ... Loop" ... I think you can acheive the same results with the below shorter code

Sub RandPT_Ver2()
Dim PT As Double, Num As Double
PT = InputBox("Enter The Total Unique Names", "Enter a Number")
Num = InputBox("Enter The 25% ", "Enter a Number")
For x = 1 To Num
    Range("AQ107").Offset(x - 1) = Int((PT * Rnd) + 1)
Next x
End Sub

 

[ffionnah]

That worked! thank you so much

 

[mse330]

Glad to help ... You are welcome & thanks for reporting back