Hi mcconns
Here is some that will create random numbers for.
Sub RandomNumberGenerator()
'Creates a list of random numbers _
between 1 and 36 in range A1:F6
'Written by OzGrid Business Applications
'www.ozgrid.com
Dim Rw As Integer, Col As Integer
Dim Reply1 As Long, Reply2 As Long, Reply3 As Long
Dim lSqR As Long
Dim lSqC As Long
Dim i As Long, lRand As Long
On Error Resume Next
Above:
Reply2 = 0
Reply2 = InputBox("Lowest number ?" _
& Chr(13) & Chr(13) & "Number must be greater than 0 and entered without spaces or commas" & Chr(13) _
, "OzGrid Random Number Generator", 1)
If Reply2 = 0 Then Exit Sub
If Reply2 < 1 Then
MsgBox "Number must be greater than 0", vbCritical, "OzGrid Business Applications"
GoTo Above
End If
Above2:
Reply3 = 0
Reply3 = InputBox("Highest number ? " _
& Chr(13) & Chr(13) & "Number must be greater than " & Reply2 & " and entered without spaces or commas" & Chr(13) _
, "Lowest number = " & Reply2, 500)
If Reply3 = 0 Then Exit Sub
If Reply3 <= Reply2 Then
MsgBox "Number must be greater than " & Reply2, vbCritical, "OzGrid Business Applications"
GoTo Above2
End If
HowMany:
Reply1 = 0
Reply1 = InputBox("How many random numbers do you wish to generate?" _
& Chr(13) & Chr(13) & "Number must be whole and less than 1000" & Chr(13) _
& Chr(13) & "An amount greater than 500 within a tight band will take some time!" _
& Chr(13) & "Numbers will be sorted Left to Right by row" _
, "Lowest number = " & Reply2 & " Highest number = " & Reply3, 200)
If Reply1 = 0 Then Exit Sub
If Reply1 > 1000 Then
MsgBox "Number must be less than 1000", vbCritical, "OzGrid Business Applications"
GoTo HowMany:
End If
If Reply1 > Reply3 - Reply2 Then
MsgBox "Not possible.", vbCritical, "OzGrid Business Applications"
GoTo HowMany:
End If
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Sheets.Add().Name = "Random Numbers"
If ActiveSheet.Name <> "Random Numbers" Then
ActiveSheet.Delete
Sheets("Random Numbers").Select
Cells.Clear
End If
Dim sCheck As String
Range("A1") = Reply1
Range("B1").FormulaR1C1 = "=ROUNDUP(SQRT(RC[-1]),0)"
lSqR = Range("B1")
lSqC = lSqR
On Error GoTo 0
'Clear the range ready for random numbers
Range("A1:IV600").Clear
Randomize ' Initialize random-number generator.
For Col = 1 To lSqC 'Set the Column numbers
If WorksheetFunction.CountA(Cells) = Reply1 Then Exit For
For Rw = 1 To lSqR 'Set the Row numbers
If WorksheetFunction.CountA(Cells) = Reply1 Then Exit For
'Cells(Rw, Col) = Int((Reply3 - Reply2 + 1) * Rnd + Reply2)
Do Until WorksheetFunction.CountIf _
(Cells, Cells(Rw, Col)) = 1
Cells(Rw, Col) = Int((Reply3 - Reply2 + 1) * Rnd + Reply2)
Loop
If WorksheetFunction.CountA(Cells) = Reply1 Then Exit For
Next Rw
If WorksheetFunction.CountA(Cells) = Reply1 Then Exit For
Next Col
Rw = 1
For Rw = 1 To ActiveSheet.UsedRange.Rows.Count
Rows(Rw).Sort Key1:=Rows(Rw).Range("A1"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlLeftToRight
Next Rw
Application.Goto Range("A1"), True
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub