Better Random, No Repeat, In Order with Excel Macro [duplicate] - vba

Question

This question already has answers here:
Unique Random Numbers using VBA
(3 answers)
Closed 6 years ago.
I have been working on this project for a while, and have had various help throughout (haven't touched code in a number of years)
I'm creating a lottery ticket generator, and I'm finally almost finished, but my random needs some work, and I'd like to display the numbers in ascending order with separated by hyphen, as the following example without the parenthesis: "12-16-24"
Currently my code puts a different random number (1-24) across three columns in a row and repeats until the loop is complete. The code should minimize the columns to 1 "lottery" column instead of three.
Any idea, how I could go about doing this? My current code to follow:
Sub New_Entry()
Dim strPlayer As String, strTick As Integer, i As Integer, j As Integer
strPlayer = InputBox("Input Player Name")
strTick = InputBox("How many tickets?")
i = Cells(Rows.Count, 1).End(xlUp).Row + 1
For i = i To i + strTick - 1
Cells(i, 1).Value = strPlayer
For j = 2 To 4
Cells(i, j).Value = Int((24 - 1 + 1) * Rnd + 1)
Next j
Next i
End Sub

Answer 1

The following might help you:
Function LotteryTicket() As String
Dim i As Long
Dim nums(1 To 3) As Integer
Dim A(1 To 3) As Variant
With Application.WorksheetFunction
Do While True
For i = 1 To 3
nums(i) = .RandBetween(1, 24)
Next i
For i = 1 To 3
A(i) = .Small(nums, i)
Next i
If A(1) <> A(2) And A(2) <> A(3) Then
LotteryTicket = Join(A, "-")
Exit Function
End If
Loop
End With
End Function
It uses a simple hit-and-miss approach to get distinct numbers. The probability that 3 randomly chosen numbers in 1-24 are distinct is P(24,3)/24^3 = 87.8% so the expected number of runs through the outer loop is less than 2.
Tested like this:
Sub test()
Dim i As Long
For i = 1 To 10
Cells(I,1).Value = LotteryTicket()
Next i
End Sub
After running this the output looks like (assuming that the cells are formatted as text so Excel doesn't interpret things as dates):
1-7-10
1-17-23
8-14-15
8-12-24
2-14-17
4-7-14
5-6-23
16-20-21
4-10-24
6-11-15

Answer 2

If you do not want repeats just test if the numbers are already in the array, if true, then calculate a new random number (this code is written for 6 winning numbers):
Sub New_Entry()
Dim strPlayer As String, strTick As Integer, i As Integer, j As Integer
Dim win_tkt As Variant
Dim number_to_find As Integer
strPlayer = InputBox("Input Player Name")
strTick = InputBox("How many tickets?")
ReDim win_tkt(5) 'how many numbers are extracted -1
i = Cells(Rows.Count, 1).End(xlUp).Row + 1
For i = i To i + strTick - 1
Cells(i, 1).Value = strPlayer
win_tkt(0) = Int((24 - 1 + 1) * Rnd + 1)
For j = 2 To 6 'from 2nd winning number to last winning number
number_to_find = Int((24 - 1 + 1) * Rnd + 1)
Do While IsInArray(number_to_find, win_tkt) = True
number_to_find = Int((24 - 1 + 1) * Rnd + 1)
Loop
win_tkt(j - 1) = number_to_find
Next j
Call sort_array(win_tkt)
Cells(i, 2).Value = Join(win_tkt, "-")
Next i
End Sub
Function IsInArray(find_number As Integer, arr As Variant) As Boolean
IsInArray = (UBound(Filter(arr, find_number)) > -1)
End Function
Sub sort_array(arr As Variant)
Dim strTemp As String
Dim i As Long
Dim j As Long
Dim lngMin As Long
Dim lngMax As Long
lngMin = LBound(arr)
lngMax = UBound(arr)
For i = lngMin To lngMax - 1
For j = i + 1 To lngMax
If arr(i) > arr(j) Then
strTemp = arr(i)
arr(i) = arr(j)
arr(j) = strTemp
End If
Next j
Next i
End Sub