Excel VB | unique random numbers

I often like to fill my excel model and workbooks with data to test out functionality and what better than a random range of numbers. (hint look in my other post about changing negative numbers to positives and vice versa if you want to make the them different sizes for instance if you wanted the numbers in the thousands).

This code below basically starts with the first cell of the selection and creates a random number and then check that number to any others in the range that are duplicates - looping until there are no matches and then carrying on to the next cell in the range to create another unique random number.

Sub RandomNoDuplicates()
Dim LowerLimit As Byte
Dim Limit2 As Long

Call CheckProtectedSheet
Call CheckForMultipleAreas

If MsgBox(”This will place a unique random number in each cell in your selection?” & vbNewLine & “(n.b. existing values will be overwritten)”, vbQuestion + vbOKCancel, AT & ” - Insert random numbers without duplicates”) = vbCancel Then Exit Sub
LowerLimit = 1
Limit2 = Selection.Cells.Count
Cellen = Selection.Cells.Count
i = 1
Selection.ClearContents

For Each rngCel In Selection
Application.StatusBar = “Processing random numbers: ” & Int((i * 100) / Cellen) & ” %”

Section1:
rngCel.Value = Int((Limit2 - LowerLimit + 1) * Rnd + LowerLimit)

If Application.WorksheetFunction.CountIf(Selection, rngCel.Value) = 1 Then
GoTo Section2
Else
GoTo Section1
End If

Section2:
i = i + 1

Next
Application.StatusBar = False

End Sub

duplicates-random-lists.zip

Related Posts

• Excel VB | XLA addin to display content of a folder
• Excel VB | XLA addin for auto cell colour format
• Excel VB | random password generator
• Excel VB | positive to negative & vice versa
• Excel VB | duplicate range highlight and remove