'Clear All
Sub bClearAll()
Dim i As Integer
For i = 1 To 6
Picks.OLEObjects("TextBox" & i).Object.Value = ""
Next i
'Picks.OLEObjects("tSet").Object.Value = 1
Picks.tSet.Value = 1
End Sub
'Generate
Sub bGenerate()
Dim ws As Worksheet, rStart As Range, rS As Range
Dim i As Long, ii As Integer, j As Long, k As Long
Dim tf As Boolean, a(1 To 6), b
Dim r As Range, rr
Set ws = Picks
Set r = Picks.Range("A1", Picks.Range("A1").End(xlDown))
'Remove possible duplicate values
rr = UniqueArrayByDict(r.Value) 'Base 0 array.
'Title Cell for first random number set on Picks sheet
Set rStart = ws.Range("G5")
'Check if any preferred numbers were set.
'All blank or all numbers means no preference.
For i = 1 To 6
a(i) = Val(Picks.OLEObjects("TextBox" & i).Object.Value)
If a(i) = 0 Then
j = j + 1
Else
k = k + 1
End If
Next i
'Ok to generate all 5 numbers?
If j = 6 Or k = 6 Then
tf = True
Else 'Add numbers that may not be in rr.
For k = 0 To 5
If a(k + 1) <> 0 Then
ReDim Preserve rr(0 To UBound(rr) + 1)
rr(UBound(rr)) = a(k + 1)
End If
Next k
End If
'Remove possible duplicate values that were added.
rr = UniqueArrayByDict(rr) 'Base 0 array.
If Not IsNumeric(Picks.tSet.Value) Then Picks.tSet.Value = 1
For i = 1 To Picks.tSet.Value
'Next blank cell in Picks sheet for next set of numbers
Set rS = ws.Cells(Rows.Count, rStart.Column).End(xlUp).Offset(1)
Generate:
If rS.Row < 5 Then Set rS = ws.Cells(5, rS.Column)
b = RndIntPick(1, UBound(rr) + 1, 6) 'Base 0 array.
'Set elements in b to rr values.
For k = 0 To 5
b(k) = rr(b(k) - 1) 'Random picks from col A in b now.
Next k
'Resort b
b = ArrayListSort(b)
If Not tf Then
For ii = 1 To 5
If a(ii) <> 0 And b(ii - 1) <> a(ii) Then GoTo Generate
Next ii
End If
For ii = 0 To 5
Picks.OLEObjects("TextBox" & ii + 1).Object.Value = Format(b(ii), "0#")
rS.Offset(, ii).Value = b(ii)
Next ii
Next i
End Sub