Need Excel to generate a random unique static number based on a specific age division

If VBA code is ok, this could work:

Sub assignRand()

Dim lRange As Long
Dim uRange As Long
Dim guess As Long
Dim NoOfTries As Long
    
With ActiveSheet

    For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row
    
        If .Cells(i, 4).Value = 0 Then
            
            Select Case .Cells(i, 1).Value
            
            Case "Junior"
                lRange = 101
                uRange = 199
            Case "Intermediate"
                lRange = 201
                uRange = 299
            Case "Senior"
                lRange = 301
                uRange = 399
            Case "N-Jr."
                lRange = 2
                uRange = 30
            Case "N-Int."
                lRange = 31
                uRange = 65
            Case "N-Sr."
                lRange = 66
                uRange = 99
            Case Else
                MsgBox .Cells(i, 1).Value & " not defined"
                Exit Sub
            End Select
            
            NoOfTries = 0
            
reassign:
            If NoOfTries = 999 Then
                MsgBox "Not able to assign"
                Exit Sub
            End If
            
            guess = Int((uRange - lRange + 1) * Rnd + lRange)
            If guess = 13 Then GoTo reassign
            If WorksheetFunction.CountIf(.Range("D2:D" & i - 1), guess) = 0 Then
                .Cells(i, 4).Value = guess
            Else
                NoOfTries = NoOfTries + 1
                GoTo reassign
            End If
    End If
    Next i

End With

End Sub

Thank you, AskMeAboutExcel.

I like the idea of using VBA because It'd be nice to turn this into a button control macro; however, I've never used VBA before, yet I'm eager to learn.

After turning on the Developer tab, I inserted a module in the workbook and then inserted a procedure. I left the type as Sub and the scope as Public. Then I copied and pasted your code above. Since my contestant data entry starts on row 8, I changed the i = 2 statement to i = 8. Also, the age division field is column E (so the 5th column from the left) and the contestant number assignment field is column H (the 8th column). Here's how I modified your code, but I must be doing something wrong because it isn't working for me. Do you see my problem? Here's what I have:

Public Sub assignRand()

'Assign Contestant Numbers

Dim lRange As Long
Dim uRange As Long
Dim guess As Long
Dim NoOfTries As Long
    
With ActiveSheet

    For i = 8 To Cells(Rows.Count, 1).End(xlUp).Row
    
        If .Cells(i, 8).Value = 0 Then
            
            Select Case .Cells(i, 5).Value
            
            Case "Junior"
                lRange = 101
                uRange = 199
            Case "Intermediate"
                lRange = 201
                uRange = 299
            Case "Senior"
                lRange = 301
                uRange = 399
            Case "N-Jr."
                lRange = 2
                uRange = 30
            Case "N-Int."
                lRange = 31
                uRange = 65
            Case "N-Sr."
                lRange = 66
                uRange = 99
            Case Else
                MsgBox .Cells(i, 5).Value & " not defined"
                Exit Sub
            End Select
            
            NoOfTries = 0
            
reassign:
            If NoOfTries = 999 Then
                MsgBox "Not able to assign"
                Exit Sub
            End If
            
            guess = Int((uRange - lRange + 1) * Rnd + lRange)
            If guess = 13 Then GoTo reassign
            If WorksheetFunction.CountIf(.Range("H8:H" & i - 1), guess) = 0 Then
                .Cells(i, 5).Value = guess
            Else
                NoOfTries = NoOfTries + 1
                GoTo reassign
            End If
    End If
    Next i

End With

End Sub

BTW... the code you provided worked great on the little sample workbook I supplied for my original post. If I used it on the non-sample workbook, I got the "not defined" message box, which is why I thought my problem was the row and column differences. Trouble is, I don't know enough about VBA to edit the code correctly.

Hi Clark,

Glad that this worked for you on the sample sheet. A little challenging to debug without you're actual data, but possibly it could be this line that's the issue:

For i = 8 To Cells(Rows.Count, 1).End(xlUp).Row

This calculates the number of times to look through the logic, based on the number of cells with Data in Column A. If your column A is blank, then it will have an error.

With your age divisions in column E, you can try editing this to

For i = 8 To Cells(Rows.Count, 5).End(xlUp).Row

Please put this code in Sheet1

Sub Urand()
Dim a, l&, i&, st&, m&
a = [LET(z,F3:G8,n,INDEX(z,,2),s,--MID(LEFT(n,FIND("-",n)-1),FIND("ween",n)+5,3),CHOOSE({1,2,3},INDEX(z,,1),s,RIGHT(n,3)-s+1))]
l = Cells(Rows.Count, 1).End(xlUp).Row

For i = 2 To l
    If Cells(i, 4) = "" Then
        st = Application.VLookup(Cells(i, 1), a, 2, 0)
        m = Application.VLookup(Cells(i, 1), a, 3, 0)
        Cells(i, 4) = Evaluate("LET(div,A2:A" & l & ",id,D2:D" & l & ",m," & m & ",l,FILTER(id,(div=""" & Cells(i, 1) & _
            """)*id,0),n,m-COUNT(l),a,SEQUENCE(m,," & st & "),SMALL(FILTER(a,ISNA(MATCH(a,l,))+(a<>13)),RANDBETWEEN(1,n)))")
    End If
Next
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Column = 1 Or Target.Column = 4 Then
        Application.EnableEvents = False
        Urand
        Application.EnableEvents = True
    End If
End Sub

Originally Posted by clark402

Thank you Bo_Ry. Unfortunately, there were duplicates within an age division. Every contestant needs a unique contestant number.

Fixed

Sub Urand()
Dim a, l&, i&, st&, m&
a = [LET(z,F3:G8,n,INDEX(z,,2),s,--MID(LEFT(n,FIND("-",n)-1),FIND("ween",n)+5,3),CHOOSE({1,2,3},INDEX(z,,1),s,RIGHT(n,3)-s+1))]
l = Cells(Rows.Count, 1).End(xlUp).Row

For i = 2 To l
    If Cells(i, 4) = "" Then
        st = Application.VLookup(Cells(i, 1), a, 2, 0)
        m = Application.VLookup(Cells(i, 1), a, 3, 0)
        Cells(i, 4) = Evaluate("LET(div,A2:A" & l & ",id,D2:D" & l & ",m," & m & ",l,FILTER(id,(div=""" & Cells(i, 1) & _
            """)*isnumber(id),0),a,SEQUENCE(m,," & st & "),n,m-COUNT(l)+sum(-(a=13)),SMALL(FILTER(a,ISNA(MATCH(a,l,))*(a<>13)),RANDBETWEEN(1,n)))")
    End If
Next
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Column = 1 Or Target.Column = 4 Then
        Application.EnableEvents = False
        Urand
        Application.EnableEvents = True
    End If

End Sub

The following Macro (Sub) and Function together will populate unique numbers in the #-Column within the ranges specified and there will be no number 13 in the list. You can set the starting row for the data (not headers) in the StartRow constant (the first Const statement), the AgeDivision column in the AgeCol constant and the output column (what you labeled #) in the NumCol constant (I assigned values that matched the data you showed us in the example workbook you posted). Copy all the code below into a general module and assign the AssignmentNumbers macro to the button you plan to put on the worksheet (the function is called by the macro, not you). Here is the code...

Sub AssignmentNumbers()
  Dim Rw As Long, J As Long, I As Long, S As Long, NJ As Long, NI As Long, NS As Long
  Dim Jun As Variant, Inter As Variant, Sen As Variant, NJun As Variant, NInt As Variant, NSen As Variant
  Const StartRow As Long = 2
  Const AgeCol As String = "A"
  Const NumCol As String = "D"
  Jun = RandomizeArray([ROW(101:199)])
  Inter = RandomizeArray([ROW(201:299)])
  Sen = RandomizeArray([ROW(301:399)])
  NJun = RandomizeArray([SUBSTITUTE(ROW(2:29),13,30)])
  NInt = RandomizeArray([ROW(31:65)])
  NSen = RandomizeArray([ROW(66:99)])
  For Rw = StartRow To Cells(Rows.Count, AgeCol).End(xlUp).Row
    Select Case Cells(Rw, AgeCol).Value
      Case "Junior"
        J = J + 1
        Cells(Rw, NumCol) = Jun(J, 1)
      Case "Intermediate"
        I = I + 1
        Cells(Rw, NumCol) = Inter(I, 1)
      Case "Senior"
        S = S + 1
        Cells(Rw, NumCol) = Sen(S, 1)
      Case "N-Jr."
        NJ = NJ + 1
        Cells(Rw, NumCol) = NJun(NJ, 1)
      Case "N-Int."
        NI = NI + 1
        Cells(Rw, NumCol) = NInt(NI, 1)
      Case "N-Sr."
        NS = NS + 1
        Cells(Rw, NumCol) = NSen(NS, 1)
    End Select
  Next
End Sub

Function RandomizeArray(ArrayIn As Variant)
  Dim Cnt As Long, RandomIndex As Long, Tmp As Variant
  For Cnt = UBound(ArrayIn) To LBound(ArrayIn) Step -1
    RandomIndex = Application.RandBetween(LBound(ArrayIn), UBound(ArrayIn))
    Tmp = ArrayIn(RandomIndex, 1)
    ArrayIn(RandomIndex, 1) = ArrayIn(Cnt, 1)
    ArrayIn(Cnt, 1) = Tmp
  Next
  RandomizeArray = ArrayIn
End Function

NOTE: New random numbers will be assigned every time the button you plan to put on the worksheet is pressed, so you may want to rethink using a button to generate your numbers as it would be so easy to accidentally click it... you can press ALT+F8 and run the macro from the dialog box that appears instead. Also note that this macro is designed to run after all the AgeDivision assignments are made. If you add a new contestant or discover a mistaken age division assignment, you will have to correct those manually if the number assignments have already been given out to the contestants (remember, running the macro randomizes all assignments).