5-digit Random Unique Alphanumeric Code

I don't know that there is a formula solution that guarentees there are no duplicates and using RANDBETWEEN is no more suseptible than other methods.

=CHAR(RANDBETWEEN(97,122)) & RANDBETWEEN(0,9) & CHAR(RANDBETWEEN(97,122)) & RANDBETWEEN(0,9) & CHAR(RANDBETWEEN(97,122))
In the next column you can run a check for any duplicates with something like

=SUMIF($A$1:A1, A1)

I would agree with ChemistB's solution. Be aware that RANDBETWEEN is volatile so if your sheet recalculates the values are all going to change. If you use this formula to generate a long list of numbers then check for duplicates using the formula provided, you can tweak those by hand to be unique. However, I used those formulas to generate 6500 numbers and in 20 trials did not find a single duplicate.

Originally Posted by mcodden

I'll try to post to the macros portion as well.

Please do not post the same question to multiple subforums. We have a rule against duplicate posts. If you feel that you should post to a different subforum please ask a moderator to move it for you.


This is a duplicate post and as such does not comply with Rule 5 of our forum rules. This thread will now be closed, you may continue in your other thread.

Thread Closed.

would be pretty simple via a macro:

Basically,
Have the macro author the formula ChemistB put up into two columns - then lock the values.

Then, have the macro 'flag' any cells with a count greater than 1 (may be tricky to make fast, think I could do it though) - Rekey -those cells (add the formula again) and then lock values... check for uniqueness again (if the SUM of the counts columns = the COUNT of records, you are good to go...)

That way it would be automatic and unique :D

See attached.

The code is pretty straightforward I would think, you would need to edit it to work on columns other than A and B. Randbetween gets you there after a couple of iterations.



edit: I tried to mark up the parts you would need to edit for another column in red type.

Option Explicit

Sub makeUniqueKeyColumn()

Dim keyCol As Range, countCol As Range, currCell As Range, needNewKeys As Range
Dim maxCount As Long, i As Long

Set keyCol = ThisWorkbook.Worksheets(1).Range("A1:A6500")
Set countCol = ThisWorkbook.Worksheets(1).Range("B1:B6500")

'make keys and counts'
keyCol.Formula = "=CHAR(RANDBETWEEN(97,122)) & RANDBETWEEN(0,9) & CHAR(RANDBETWEEN(97,122)) & RANDBETWEEN(0,9) & CHAR(RANDBETWEEN(97,122))"
countCol.FormulaR1C1 = "=countIF(R1C1:R6500C1 , RC1)"

'lock values'
keyCol.Value = keyCol.Value
countCol.Value = countCol.Value

'check uniqueness'
If WorksheetFunction.Sum(countCol) > WorksheetFunction.CountA(keyCol) Then
    Do
    
    maxCount = WorksheetFunction.Max(countCol)
    For i = maxCount To 2 Step -1
        countCol.Replace what:=i, replacement:="REDO"
    Next i
    
    Call collection_Matches(countCol, needNewKeys, "REDO", False)
    
    For Each currCell In needNewKeys
1:
        'rekey'
        keyCol.Cells(currCell.Row, 1).Formula = "=CHAR(RANDBETWEEN(97,122)) & RANDBETWEEN(0,9) & CHAR(RANDBETWEEN(97,122)) & RANDBETWEEN(0,9) & CHAR(RANDBETWEEN(97,122))"
        currCell = "=countIF(R1C1:R6500C1 , RC1)"
        'lock'
        keyCol.Cells(currCell.Row, 1).Value = keyCol.Cells(currCell.Row, 1).Value
        currCell.Value = currCell.Value
        'check'
        If currCell > 1 Then GoTo 1
    Next currCell
        
    Loop While WorksheetFunction.Sum(countCol) > WorksheetFunction.CountA(keyCol)
End If

End Sub



'Below is just a standard routine used to create a range collection of all matches'

Sub collection_Matches(ByRef fullRange As Range, ByRef matchRange As Range, findValue As String, ByRef findResults As Boolean)

Dim currC As Range, firstC As Range
Dim collectionC As Range


findResults = False
Set currC = fullRange.Find(what:=findValue, LookIn:=xlFormulas, lookat:=xlPart)

If Not currC Is Nothing Then
    findResults = True
End If

If findResults Then

    Set firstC = currC
        
    Do
    If collectionC Is Nothing Then
        Set collectionC = currC
    Else
       Set collectionC = Union(currC, collectionC)
    End If
    Set currC = fullRange.FindNext(currC)
    Loop While Not currC.Address = firstC.Address

    Set matchRange = collectionC
End If

End Sub

LOL, this was the first post....