Macros Serial number generation with repeatability comparison base

[K0st4din]

Hi all, after a lot of searching I managed to find something similar on the site that comes close to what I want to do.

Macro to generate random serial number

Hi guys, I need to generate some serial number to provide to our students and I'm looking for a macro to do it. Ideally, I enter in cell A1 the number of key code to generate and it will generate those in the following format: 3XA7-BC6D-98EF Can mix letter (Capital only) and number. But should...

www.mrexcel.com

But since I don't understand anything, I can't even modify it for my needs, I am asking for your macro help.
I will attach my excel file.
I want to generate random serial numbers and in different situations with different character lengths ie 12 or 14 or 16 or 18.
In cell I2 I have made a drop down menu to choose how many characters to be. In cell J2 - what type should they be (ie Only uppercase letters and numbers, only numbers or lowercase, uppercase and numbers, or some of my choice of selected characters, etc.).
In cell K2, I record how many Countless combinations to generate according to the choices made that start from/in cell A1 to the end (just an example: be it 3, 34569 or 1 million).
Here it comes (and what I was able to find on the site) is to be able in the second worksheet (with some name given by me) to be able to accumulate a base, with already generated combinations, so that there is never repetition in the new ones generated.
Since I have no idea if the macro can add columns, I have made several of the different types of combinations, be it 12, 14, 16 or 18. If after the first column is filled, the macro can add a new column with the search criteria, then it will make no sense for me to put columns for each type (but I leave this as a last touch, to have your say).
I would be extremely grateful if you could help me.
One more thing, in the link where I found a similar solution, there the user requires to have some hyphens, in my case, I don't need them, that is, I need something like this: for example: ODN81T6DRJJY8S or ODN81T6DRJJY8S49 or 068249317896) i.e. is without any signs.
Thanks in advance to each one!

Test serial numbers.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P
1									? Combination	Select model letters and numbers	How many numbers you need			12	ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789
2									14	ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789	987254			14	ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789
3														16	abcdefghijklmnopqrstuvwxyz0123456789
4														18	0123456789
5
6
7
8
9
10
generate numbers

Cells with Data Validation
Cell	Allow	Criteria
I2	List	=$N$1:$N$5
J2	List	=$O$1:$O$11

Test serial numbers.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T	U	V	W	X	Y	Z
1	12	12	12	12	12	12	12	12	14	14	14	14	14	14	14	14	16	16	16	16	16	16	16	16
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
base generated numbers

 

[K0st4din]

Wow, this is amazing.
I never imagined it to look so smart and practical!
To be honest, I also thought that somewhere there were name tags, but when I looked, it wasn't written, and I didn't know where to put it (like a range).
Yes, it is definitely much easier now, to be able to just write down the length and type of numbers. I wrote it because it is no problem to go into the macro and change, but somehow it is much nicer to do it only in the table.
Thank you so much for the quick help and wonderful solution.
I can wish you to be alive and healthy and to always help people like me who can't cope with a problem!

 

[K0st4din]

Hello again,
I want to thank you again for the macro, which is great.
However, there is one small detail that during the conversations we had, I got the impression that I can even generate at one time even 1 million numbers, I decided to try and it gave me an error, even after 150,000 lines here:

MakeCodes = Application.Transpose(d.Items)

I searched the internet and somewhere they say that this Transponse should not be used because it gave the problems for more lines.
How can we fix this problem?
Thank you in advance!

 

[K0st4din]

This is some other site where they mention this problem.

Is there a way to generate 100K unique 8-9 characters in excel

I am trying to use the below macro to generate 100K unique IDS/Strings in excel. However, it's failing to generate more than 34,464 rows. I get "#NA" I am not an expert so there's something defi...

stackoverflow.com

I don't know what to change to keep everything the same but without this problem.

 

[StephenCrump]

Try changing to:

Sub Test()

    Dim s As Variant
    Dim c() As String
    Dim L As Long, LastCol As Long, N As Long
    Dim r As Range
    
    N = Range("No").Value
    L = Range("Length").Value
    s = Split(StrConv(Range("Characters").Value, vbUnicode), Chr(0))
    ReDim Preserve s(UBound(s) - 1)
    
    c = MakeCodes(N, L, s)

    On Error Resume Next
    Range("MyCodes").ClearContents
    On Error GoTo 0

    With Range("PutResultsHere").Resize(N)
        .Value = c
        .Name = "MyCodes"
    End With
    
    If Range("SaveToVault").Value Then
        With Worksheets("Vault")
            Set r = .Cells(1, Columns.count).End(xlToLeft)
            With .Columns(r.Column + IIf(Len(r), 1, 0))
                .Cells(2).Resize(N).Value = c
                .AutoFit
                .Cells(1).Value = Now()
                .Cells(1).NumberFormat = "d mmm yyyy hh:mm:ss"
            End With
        End With
    End If
    
End Sub
Function MakeCodes(N As Long, L As Long, s As Variant) As String()
    
    Dim d As Scripting.Dictionary
    Dim tmp As String, Output() As String
    Dim i As Long, count As Long
    
    Set d = New Scripting.Dictionary
    d.CompareMode = vbBinaryCompare
    ReDim Output(1 To N, 1 To 1)
    Randomize
    
    Do Until d.count = N
        tmp = ""
        For i = 1 To L
            tmp = tmp & s(Int((UBound(s) - LBound(s) + 1) * Rnd()))
        Next i
        On Error Resume Next
        d.Add tmp, tmp
        If Err = 0 Then
            count = count + 1
            Output(count, 1) = tmp
        End If
        On Error GoTo 0
    Loop

    MakeCodes = Output
    
End Function

 

[K0st4din]

Hello again,
now everything works as it should and does not give this error.
Apparently, this line really confuses things. For fewer lines there is no problem, but with more something bothers him.
Thank you very much for your quick response.
Be alive and healthy!

 

[K0st4din]

Hello
sorry to go back to the topic and the question, but after confirming that everything is OK.
Turns out that wasn't exactly the case.
Why:
After fixing the macro and saying everything was ok, I had forgotten to add Sub CheckVault() - and while I was generating 1 million combinations a day, for days on end, I was checking for yellow duplicates and it kept telling me there weren't any.
Realizing I had forgotten to add CheckVault(), I did so today, and upon enabling the macro to do a new 1 million combinations, it again didn't yellow me if there was any random repeat.
For me, it is unacceptable for there to be a repetition, because I will open myself up to very big problems.
Please look at it one more time, why is it so.
Is there a problem that on one day for example I generate 2 million and save the table and on another day I generate other millions?
I was very worried to see that it doesn't show me the duplicates because if I see them, it's no problem to delete a row or two and everything will be fine.
Thank you very much!

Sub Testserialnumbers()

    Dim s As Variant
    Dim c() As String
    Dim L As Long, LastCol As Long, N As Long
    Dim r As Range
    
    N = Range("No").Value 'is a B4
    L = Range("Length").Value ' is a B3
    s = Split(StrConv(Range("Characters").Value, vbUnicode), Chr(0)) 'is B2
    ReDim Preserve s(UBound(s) - 1)
    
    c = MakeCodes(N, L, s)

    On Error Resume Next
    Range("MyCodes").ClearContents 'is a B8
    On Error GoTo 0

    With Range("PutResultsHere").Resize(N)
        .Value = c
        .Name = "MyCodes" ' is a B8
    End With
    
    If Range("SaveToVault").Value Then 'is a B5
        With Worksheets("Vault") ' is a sheet Vault
            Set r = .Cells(1, Columns.count).End(xlToLeft)
            With .Columns(r.Column + IIf(Len(r), 1, 0))
                .Cells(2).Resize(N).Value = c
                .AutoFit
                .Cells(1).Value = Now()
                .Cells(1).NumberFormat = "d mmm yyyy hh:mm:ss"
            End With
        End With
    End If
    
End Sub
Function MakeCodes(N As Long, L As Long, s As Variant) As String()
    
    Dim d As Scripting.Dictionary
    Dim tmp As String, Output() As String
    Dim i As Long, count As Long
    
    Set d = New Scripting.Dictionary
    d.CompareMode = vbBinaryCompare
    ReDim Output(1 To N, 1 To 1)
    Randomize
    
    Do Until d.count = N
        tmp = ""
        For i = 1 To L
            tmp = tmp & s(Int((UBound(s) - LBound(s) + 1) * Rnd()))
        Next i
        On Error Resume Next
        d.Add tmp, tmp
        If Err = 0 Then
            count = count + 1
            Output(count, 1) = tmp
        End If
        On Error GoTo 0
    Loop

    MakeCodes = Output
    
End Function
Sub CheckVault()

    Dim d As Scripting.Dictionary
    Dim vIn As Variant
    Dim r As Long, c As Long, count As Long
    Dim Dups As String

    Set d = New Scripting.Dictionary
    d.CompareMode = vbBinaryCompare
    vIn = Worksheets("Vault").Range("A1").CurrentRegion.Value

    For c = 1 To UBound(vIn, 2)
        For r = 1 To UBound(vIn)
            If vIn(r, c) = "" Then Exit For
            On Error Resume Next
            d.Add vIn(r, c), vIn(r, c)
            If Err Then
                Dups = Dups & vIn(r, c) & vbLf
                count = count + 1
            End If
            On Error GoTo 0
        Next r
    Next c

    MsgBox count & " duplicates" & vbLf & vbLf & Dups

End Sub

 

[StephenCrump]

The way the code is currently written ..

- Sub MakeCodes will generate a single batch of codes with no duplicates in that batch. If SaveToVault is TRUE, it will save the batch, with a timestamp, to the "Vault" worksheet. It will not check whether the new batch contains codes already in the Vault.

- Sub CheckVault will check all codes in the Vault for duplicates.

Are you saying that Sub CheckVault is not doing this correctly?

If you wish, we could rewrite the code so that Sub MakeCodes looks at the Vault whilst it is generating a new batch, so that no duplicates ever get printed out or saved to the Vault?

But can I ask why you need to be generating "1 million combinations a day, for days on end"? What's the purpose of doing so?

 

[K0st4din]

Hi, it's too long to tell and we'll get off topic. My idea was, just like that, to have absolutely no repeats, no matter how many millions I make, be it in a day or in weeks, months. But since I need a database with these combinations, and the excel file becomes very large in hundreds of megabytes, I therefore make/generate several million every day and then take the necessary number of these generated numbers. But the most important thing remains, even if I have a billion, there should be no repetitions. Thank you very much for your help!

 

[StephenCrump]

OK, but you haven't answered the question:

Are you saying that Sub CheckVault is not doing this correctly?

As far as I can see, it should identify any duplicates in the Vault? (albeit after they have been written there).

 

[K0st4din]

Excuse me, because I was writing on the phone and I forgot to answer.
As I said at the beginning, I forgot to put the macro to do the check when I activate it with the button (I thought it did it automatically - which is my mistake, more likely an oversight).
So - Yes, it works.
I thought there would be no repeatability, because realistically, for example, if I have a choice of AZ-0-1 with 14 combinations, that makes 36 by the 14th, which is almost infinity.
I after several days pressed the button and generated 11 million and then - yesterday, when I pressed the repeatability check button, the check became terribly long, I didn't even wait for it, I even closed the table.
It's all super super cool, if only I could avoid this repetitiveness.
Let me ask this (this is going around in my head) - is it possible that if I generated 2 million today and I save the table and tomorrow I generate 3 million, somehow it can't understand it and figuratively speaking it thinks that it starts a kind of always from the beginning?
Thank you very much!