VBA - Generating numbers between 1-20 with no duplicates

[SwiftM]

Hi,

Basically, I have a button which when I click, inserts a number between 1 and 20 in cell "A1". When I click the button again, it realises that cell A1 is already taken and inserts another number between 1 and 20 in cell "A2"and so forth.

What I am struggling to do is finding a way so that the numbers are not repeated when I click the button? And when all the numbers (1 to 20) have been inserted up to "A20" then a message box appears stating that there are no numbers left.

This is my code so far: ( I am quite new to this so bare with me)

Dim MyMax As Long
MyMax = 20
Dim FillRange As Range
Set FillRange = Range("A1:A20")
With ThisWorkbook.Worksheets("October 2021")
Set FillRange = .Cells(.Rows.Count, 1).End(xlUp)
End With
If FillRange <> vbNullString Then
Set FillRange = FillRange.Offset(1, 0)
End If
For Each c In FillRange
Do
c.Value = Int((MyMax * Rnd) + 1)

Loop Until WorksheetFunction.CountIf(FillRange, c.Value) < 2
Next


Any help with this would be amazing as I have been trying all night and can't figure it out.

Thanks a lot

 

[StephenCrump]

Welcome to the Forum!

There are many ways you could do this. Here's one that uses Excel's dynamic array functions:

Sub Test()

    Const N = 20
    
    With Worksheets("October 2021").Range("A1").Resize(N)
        .Cells(1).Formula2 = "=SORTBY(SEQUENCE(" & N & "),RANDARRAY(" & N & "))"
        .Value = .Value
    End With

End Sub

 

[Peter_SSs]

Welcome to the MrExcel board!

This is my interpretation of what you are asking.
Put a heading in cell A1, say "Numbers", then use this code for each button click.

Sub RndNums()
  Dim nums As Variant
  Dim i As Long, lr As Long
  
  Randomize
  nums = Split(Join(Application.Transpose(Evaluate("Row(1:20)"))))
  With Sheets("October 2021")
    lr = .Range("A" & Rows.Count).End(xlUp).Row
    If lr = 21 Then
      MsgBox "No numbers left"
    Else
      For i = 2 To lr
        nums(.Range("A" & i).Value - 1) = "x"
      Next i
      .Range("A" & lr + 1).Value = Filter(nums, "x", False)(Int(Rnd() * (21 - lr)))
    End If
  End With
End Sub

 

[JEC]

Here some code to generate 1-20 immediately, although I think Peters' solution is what you mean.

Sub jvr()
  ar = [transpose(row(1:20))]
  st = Application.RandArray(20, 1)
  ReDim sp(1 To 20)
  
  For j = 1 To 20
      sp(j) = ar(Application.Match(Application.Large(st, j), st, 0))
  Next

  Range("A1:A20") = Application.Transpose(sp)
End Sub

 

[Peter_SSs]

Here some code to generate 1-20 immediately,

That could also be done with a one-liner by adapting Stephen's formula idea

Sub Rnd1to20()
  Sheets("October 2021").Range("A1:A20").Value = Evaluate("SORTBY(SEQUENCE(20),RANDARRAY(20))")
End Sub

 

[kvsrinivasamurthy]

Try this code

Sub RndNums()
Dim Str As String
K = WorksheetFunction.Count(Range("A1:A20"))
If K = 20 Then
MsgBox ("All 20 numbers are filled.")
Else
ReDim A(1 To 20 - K)
For T = 1 To 20
If WorksheetFunction.CountIf(Range("A1:A20"), T) = 0 Then
X = X + 1
A(X) = T
End If
Next T
N = Application.RandBetween(1, 20 - K)
Range("A" & K + 1) = A(N)
End If
End Sub

 

[kvsrinivasamurthy]

The code in my previous post fills one number for one click as you explained in first post.

 

[Marc L]

Hi, a no looping VBA demonstration to paste to the worksheet module, column B must be blank :​

Sub Demo1()
        Dim V
    With [A1].CurrentRegion
            V = Filter(Evaluate("IF(ISNA(MATCH(COLUMN(A:T)," & .Address & ",0)),COLUMN(A:T))"), False, False)
        If UBound(V) < 0 Then MsgBox "No number left …", vbExclamation, "1-20 randomization" _
        Else .Cells(.Rows.Count)(2 + IsEmpty(.Cells(.Rows.Count))).Value2 = V(Application.RandBetween(0, UBound(V)))
    End With
End Sub

 

[Peter_SSs]

The code in my previous post fills one number for one click as you explained in first post.

As did post 3 code

Another possible non-looping method, with easy adjustment if the upper limit of the number range is changed.

Sub RndNums_v2()
  Dim n As Long
  
  Const H As Long = 20 '<- Adjust to Highest possible number
  
  With Range("A1").Resize(H)
    n = Evaluate("count(" & .Address & ")")
    If n = H Then
      MsgBox "All " & H & " numbers used"
    Else
      .Cells(n + 1) = Evaluate("let(s,sequence(" & H & "),index(filter(s,isna(match(s," & .Address & ",0))),randbetween(1," & H - n & ")))")
    End If
  End With
End Sub

 

[Marc L]

with easy adjustment if the upper limit of the number range is changed.

My demonstration revamped in case the upper bound may change or if column B is not empty (to paste to the worksheet module) :​

Sub Demo1r()
    Dim V
        V = [A1].Resize(, 20).Address
    With [A1].CurrentRegion.Columns(1)
            V = Filter(Evaluate("IF(ISNA(MATCH(COLUMN(" & V & ")," & .Address & ",0)),COLUMN(" & V & "))"), False, False)
        If UBound(V) < 0 Then MsgBox "No number left …", vbExclamation, "1-20 randomization" _
        Else .Cells(.Rows.Count)(2 + IsEmpty(.Cells(.Rows.Count))).Value2 = V(Application.RandBetween(0, UBound(V)))
    End With
End Sub