Sub RandomNumbers()
Dim Src As Range, NextSet As Range
Dim i As Long, j As Long, NumberOfSets As Long, n As Long, pos As Long
Dim NextSetString As String, AllSetsString As String, s As String
Randomize
Set Src = Range("A1:V1")
NumberOfSets = Range("B4")
[COLOR="Red"][B] If NumberOfSets > 3160080 Then
MsgBox "The requested number of sets is greater than the maximum possible."
Exit Sub
End If[/B][/COLOR]
AllSetsString = ""
i = 1
While i < NumberOfSets + 1
[COLOR="SeaGreen"][B] If i + 3 > Rows.Count Then
MsgBox "There's no more rows on this sheet to place new sets. Exiting."
Exit Sub
End If[/B][/COLOR]
Set NextSet = Range("D" & 3 + i).Resize(, 5)
NextSetString = ""
j = 0
While j < 5
n = Src(Int(22 * Rnd(1)) + 1)
[COLOR="Blue"][B]s = Right(CStr(n + 100), 2)[/B][/COLOR]
pos = InStr(NextSetString, s)
If (pos = 0) Or (pos Mod 2 <> 1) Then
j = j + 1
NextSetString = NextSetString & s
NextSet(j) = n
End If
Wend
NextSet.Sort key1:=NextSet(1), Orientation:=xlLeftToRight
NextSetString = ""
For j = 1 To 5
s = Right(CStr(NextSet(j) + 100000), 2)
NextSetString = NextSetString & s
Next
pos = InStr(AllSetsString, NextSetString)
If (pos = 0) Or (pos Mod 10 <> 1) Then i = i + 1
Wend
End Sub