2

I am trying to generate 1000 unique two digit alphanumeric codes on excel. I can use small caps, large caps alphabets and numbers from 0 to 9. This gives me 62*62 = 3844 possible combinations. So in theory, 1000 is possible but I am not able to generate those.

Have tried combining char and rand function but it still doesn't incorporate small caps alphabets and I am not sure how to I ensure uniqueness

Please help me on this

ssjion3
  • 21
  • 1
  • 3
    Could you share your code so we don't have to type it from scratch? You can [edit](https://stackoverflow.com/posts/67128251/edit) your post at any time. Also (26+10)^2 is over 1000, so you don't need small caps. What seems to be the problem? The randomness? – VBasic2008 Apr 16 '21 at 15:49
  • General technique: generate a list of all valid candidates, shuffle the list, take the top 1000 items from the list – chris neilsen Apr 17 '21 at 09:42
  • @chrisneilsen: Could you share a link to a solution that is demonstrating this? Preferably to one of your solutions. – VBasic2008 Apr 17 '21 at 09:51
  • 1
    @VBasic2008 here's a [shuffle](https://stackoverflow.com/a/18543399). Adapting that to solve the rest of this Q is trivial – chris neilsen Apr 17 '21 at 09:56

3 Answers3

1

With the dynamic array formula available with a subscription to Office 365 use:

=LET(seq,SEQUENCE(75),
    chr,CHAR(FILTER(seq,(seq<=10)+((seq>=18)*(seq<=43))+(seq>=50))+47),
    cnt,COUNTA(chr),
   flsq,SEQUENCE(cnt*cnt,,0),
    fst,INDEX(chr,INT(flsq/cnt)+1),
    scd,INDEX(chr,MOD(flsq,cnt)+1),
   unarr, INDEX(UNIQUE(RANDARRAY(3000,,1,COUNTA(fst),TRUE)),SEQUENCE(1000)),
   lst, fst&scd,
   INDEX(lst,unarr))

enter image description here

Scott Craner
  • 148,073
  • 10
  • 49
  • 81
1

Get 1000 'Random' Two-Character Unique Alpha-Numerics Using a Dictionary

  • Adjust the values in the constants section.
Option Explicit

Sub arrRandomUniqueTwoCharsTEST()
    
    Const wsName As String = "Sheet1"
    Const First As String = "A2"
    
    Const ItemsCount As Long = 1000 ' 3844 is max

    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    With wb.Worksheets(wsName).Range(First).Resize(ItemsCount)
        .NumberFormat = "@"
        .Value = Application.Transpose(arrRandomUniqueTwoChars(ItemsCount))
    End With

End Sub

Function arrRandomUniqueTwoChars( _
    ItemsCount As Long) _
As Variant
    
    Dim arr(0 To 61) As String
    Dim i As Long, n As Long
    
    For i = 65 To 90: arr(n) = Chr(i): n = n + 1: Next i
    For i = 48 To 57: arr(n) = Chr(i): n = n + 1: Next i
    For i = 97 To 122: arr(n) = Chr(i): n = n + 1: Next i
    
    n = 0
    Dim arr2(0 To 3843) As String
    Dim j As Long
    
    For i = 0 To 61
        For j = 0 To 61
            arr2(n) = arr(i) & arr(j)
            n = n + 1
        Next j
    Next i

    Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
    dict.CompareMode = vbBinaryCompare
    Dim cString As String
    Do
        Randomize
        cString = arr2(Int(3844 * Rnd))
        dict(cString) = Empty
    Loop Until dict.Count = ItemsCount
    
    arrRandomUniqueTwoChars = dict.Keys
    
End Function
VBasic2008
  • 44,888
  • 5
  • 17
  • 28
0

not random, but unique

Sub Get1000UniqueStringsInColumnA()
    Const wsName As String = "Sheet1"
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    Dim n As Long
    Dim ls As Long
    Dim x As Long
    Dim AllowedChars As String
    AllowedChars = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789"
    ls = Len(AllowedChars)
    For n = 0 To 999
        x = Int(n / ls)
        wb.Worksheets(wsName).Cells(n + 1, 1).Value = Mid(AllowedChars, x + 1, 1) & Mid(AllowedChars, (n - (x * ls)) + 1, 1)
    Next n
End Sub

random and unique (with Collection):

Sub Get1000RandomUniqueStringsInColumnA()
    Const wsName As String = "Sheet1"
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    Dim n As Long
    Dim ls As Long
    Dim x As Long
    Dim AllowedChars As String
    Dim Coll As New Collection
    
    AllowedChars = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789"
    ls = Len(AllowedChars)
    For n = 0 To (ls * ls) - 1
        x = Int(n / ls)
        Coll.Add (Mid(AllowedChars, x + 1, 1) & Mid(AllowedChars, (n - (x * ls)) + 1, 1))
    Next n
    For n = 1 To 1000
        x = Int(Coll.Count * Rnd) + 1
        wb.Worksheets(wsName).Cells(n, 1).Value = Coll(x)
        Coll.Remove (x)
    Next n
End Sub
sascha4532
  • 84
  • 1
  • 3