Cycle Count Generator

[kumatsu]

I am wanting to create a random pick generator that picks 15-20 numbers from a list without repeating and keeping track of the picked numbers and not picking them again in future picks. But will auto reset once all the items in the list have been picked. If possible.

 

[Joe4]

Thanks for that. That is a big help in seeing your data and output.
I modified the code from item 2 in that link, and it seems to work on your data.
I added a few more variables, so you can simply edit the commented variables at the top of the code, in case the specs change, and it should then filter through to the code.

Give this a try:

Sub Select_Any_NumberOf_Names()

Dim xNumber As Integer
Dim xNames As Long
Dim xRandom As Integer
Dim Array_for_Names() As String
Dim j As Byte
Dim CellsOut_Number As Long
Dim Ar_I As Byte
Dim first_data_row As Long
Dim colNum As Long

Application.ScreenUpdating = False

'First row with data
first_data_row = 2
'Number of selections to make
xNumber = 15
'Row number to paste results to
CellsOut_Number = 3
'Column number to paste results to
colNum = 9

ReDim Array_for_Names(1 To xNumber)
xNames = Application.CountA(Range("A:A")) - (first_data_row - 1)

j = 1

Do While j <= xNumber
RandomNo:
    xRandom = Application.RandBetween(first_data_row, xNames + 1)
    For Ar_I = LBound(Array_for_Names) To UBound(Array_for_Names)
        If Array_for_Names(Ar_I) = Cells(xRandom, 1).Value Then
            GoTo RandomNo
        End If
    Next Ar_I
    Array_for_Names(j) = Cells(xRandom, 1).Value
    j = j + 1
Loop

For Ar_I = LBound(Array_for_Names) To UBound(Array_for_Names)
    Cells(CellsOut_Number, colNum) = Array_for_Names(Ar_I)
    CellsOut_Number = CellsOut_Number + 1
Next Ar_I

Application.ScreenUpdating = True

End Sub

 

[kumatsu]

Thank you so much for your assistance.

 

[Joe4]

You are welcome.
So, did that work for you?

 

[kumatsu]

You are welcome.
So, did that work for you?

It did!! I do have one question. Is there a way to have it only pull a number once and to start over once all have been picked at least once?

 

[Joe4]

Is it sometimes pulling the same number more than once (I ran a few tests, and did not see that happening)?

To do multiple rounds, I would change the procedure to one that has parameters that you feed into it, like this:

Sub Select_Any_NumberOf_Names(first_data_row As Long, xNumber As Long, rowNum As Long, colNum As Long)
'Variables
' - first_data_row: first row that the data we are looking in starts on
' - xNumber:        the number of random entries to pull
' - rowNum:         the row number to return the first random entry to
' - colNum:         the column in which to return the random entries to


Dim xNames As Long
Dim xRandom As Integer
Dim Array_for_Names() As String
Dim j As Byte
Dim Ar_I As Byte

Application.ScreenUpdating = False

ReDim Array_for_Names(1 To xNumber)
xNames = Application.CountA(Range("A:A")) - (first_data_row - 1)

j = 1

Do While j <= xNumber
RandomNo:
    xRandom = Application.RandBetween(first_data_row, xNames + 1)
    For Ar_I = LBound(Array_for_Names) To UBound(Array_for_Names)
        If Array_for_Names(Ar_I) = Cells(xRandom, 1).Value Then
            GoTo RandomNo
        End If
    Next Ar_I
    Array_for_Names(j) = Cells(xRandom, 1).Value
    j = j + 1
Loop

For Ar_I = LBound(Array_for_Names) To UBound(Array_for_Names)
    Cells(rowNum, colNum) = Array_for_Names(Ar_I)
    rowNum = rowNum + 1
Next Ar_I

Application.ScreenUpdating = True

End Sub

Then, you could call it multiple times, with different values, like this:

Sub RunAll()

'   Call first round of random entries, and paste starting in cell I3
    Call Select_Any_NumberOf_Names(2, 15, 3, 9)
    
'   Call second round of random entries, and paste starting in cell I18
    Call Select_Any_NumberOf_Names(2, 15, 18, 9)
    
End Sub

So you only run this second macro (note that the only thing I changed was the starting row number to paste the first random result to, from row 3 to row 18).

 

[kumatsu]

Is it sometimes pulling the same number more than once (I ran a few tests, and did not see that happening)?

To do multiple rounds, I would change the procedure to one that has parameters that you feed into it, like this:

Sub Select_Any_NumberOf_Names(first_data_row As Long, xNumber As Long, rowNum As Long, colNum As Long)
'Variables
' - first_data_row: first row that the data we are looking in starts on
' - xNumber:        the number of random entries to pull
' - rowNum:         the row number to return the first random entry to
' - colNum:         the column in which to return the random entries to


Dim xNames As Long
Dim xRandom As Integer
Dim Array_for_Names() As String
Dim j As Byte
Dim Ar_I As Byte

Application.ScreenUpdating = False

ReDim Array_for_Names(1 To xNumber)
xNames = Application.CountA(Range("A:A")) - (first_data_row - 1)

j = 1

Do While j <= xNumber
RandomNo:
    xRandom = Application.RandBetween(first_data_row, xNames + 1)
    For Ar_I = LBound(Array_for_Names) To UBound(Array_for_Names)
        If Array_for_Names(Ar_I) = Cells(xRandom, 1).Value Then
            GoTo RandomNo
        End If
    Next Ar_I
    Array_for_Names(j) = Cells(xRandom, 1).Value
    j = j + 1
Loop

For Ar_I = LBound(Array_for_Names) To UBound(Array_for_Names)
    Cells(rowNum, colNum) = Array_for_Names(Ar_I)
    rowNum = rowNum + 1
Next Ar_I

Application.ScreenUpdating = True

End Sub

Then, you could call it multiple times, with different values, like this:

Sub RunAll()

'   Call first round of random entries, and paste starting in cell I3
    Call Select_Any_NumberOf_Names(2, 15, 3, 9)
   
'   Call second round of random entries, and paste starting in cell I18
    Call Select_Any_NumberOf_Names(2, 15, 18, 9)
   
End Sub

So you only run this second macro (note that the only thing I changed was the starting row number to paste the first random result to, from row 3 to row 18).

No, it's not pulling the same number multiple times. Let me clarify. Is there a way to randomly pull a number and then eliminate that number from future pulls until all numbers in the list have been pulled once. Once all the number in the list have been pulled once, then the macro resets back to the complete list again.

 

[Joe4]

I think we may be talking about different things.

With each pull of 15 random numbers (like in your example), I am not getting any duplicates (and I suspect you are not either).
But it sounds like you are doing multiple random pulls of 15, and do not any duplicates when all those multiple pulls are considered together.
For example, none of the 15 from the second pull should match any from the first pull.
Is that what are you saying?

If that is what you mean, then I would say rather than trying to do something like that, why not pull the total number of random values you need right from the start (i.e. return 150 instead of 15, or whatever your total number needed is)?

 

[kumatsu]

I think we may be talking about different things.

With each pull of 15 random numbers (like in your example), I am not getting any duplicates (and I suspect you are not either).
But it sounds like you are doing multiple random pulls of 15, and do not any duplicates when all those multiple pulls are considered together.
For example, none of the 15 from the second pull should match any from the first pull.
Is that what are you saying?

If that is what you mean, then I would say rather than trying to do something like that, why not pull the total number of random values you need right from the start (i.e. return 150 instead of 15, or whatever your total number needed is)?

That's it. I am using this to generate a list of items that should be counted daily. Within 90 days going through our entire inventory. That's why I need to pull 15 or 20 random values daily without repeating.

 

[Joe4]

OK, that gets kind of tricky. I can think up of some ways of doing it, but they are pretty brute force, and the inefficiency might cause the code to be kind of slow, especially as you use more and more records. I have seen @DanteAmor do some pretty cool things like this in the past, so maybe he can help. I tagged him, so maybe he will take a run at it, if he wants to.

 

[kumatsu]

OK, that gets kind of tricky. I can think up of some ways of doing it, but they are pretty brute force, and the inefficiency might cause the code to be kind of slow, especially as you use more and more records. I have seen @DanteAmor do some pretty cool things like this in the past, so maybe he can help. I tagged him, so maybe he will take a run at it, if he wants to.

Thank you for all the help.