Generate Unique number for data with certain criteria

M

miicker

Board Regular
Joined
Jun 1, 2014
Messages
75
Hello Everyone,

I have a sheet and I want to give certain rows a unique number, so when I delete those rows, the number will not be used again.
I want to give every row where Column B is the same and Column D is the same and Column L is the same, the same number, so like this:

Column B (Truck)Column D (EmployeeNR)Column L (Date)Column S (Unique Number)
1514-6-20140001
3414-6-20140002
1514-6-20140001
2414-6-20140003
1614-6-20140004
3414-6-20140002
1514-6-20140001

<tbody>
</tbody>

And I want that when I clear the table, The number that already have been used in the past, will not be used again. (This is optional), So when this is not an option, its not necessary.

Kind regards,
Miicker
 

Excel Facts

Why are there 1,048,576 rows in Excel?
The Excel team increased the size of the grid in 2007. There are 2^20 rows and 2^14 columns for a total of 17 billion cells.
Sort by date Sort by votes
Try this:-
You need a reference to the numbers used and I have used range("ZZ100") to hold that reference.
If you delete the numbers produces in column "S" and re-run the code you will get a new set of numbers.
Code: 
[COLOR="Navy"]Sub[/COLOR] MG14Jun35
[COLOR="Navy"]Dim[/COLOR] Rng         [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] Dn          [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] n           [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] Txt         [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String[/COLOR]
[COLOR="Navy"]Dim[/COLOR] Dic         [COLOR="Navy"]As[/COLOR] Object
[COLOR="Navy"]Dim[/COLOR] Num         [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String[/COLOR]
[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("B2"), Range("B" & Rows.Count).End(xlUp))
    [COLOR="Navy"]Set[/COLOR] Dic = CreateObject("scripting.dictionary")
        Dic.CompareMode = vbTextCompare
            n = IIf(IsEmpty(Range("ZZ100")), 0, Range("ZZ100"))


[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
    [COLOR="Navy"]If[/COLOR] Dn.Offset(, 17) = vbNullString [COLOR="Navy"]Then[/COLOR]
        Txt = Dn & Dn.Offset(, 2) & Dn.Offset(, 10)
            [COLOR="Navy"]If[/COLOR] Not Dic.exists(Txt) [COLOR="Navy"]Then[/COLOR]
                n = n + 1: Num = n
                Dic.Add Txt, n
            [COLOR="Navy"]Else[/COLOR]
                Num = Dic.Item(Txt)
            [COLOR="Navy"]End[/COLOR] If
                [COLOR="Navy"]With[/COLOR] Dn.Offset(, 17)
                    .NumberFormat = "000"
                    .Value = Num
                [COLOR="Navy"]End[/COLOR] With
    [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR]
[COLOR="Navy"]If[/COLOR] Dic.Count > 0 [COLOR="Navy"]Then[/COLOR] Range("ZZ100") = Application.Max(Dic.items)
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
 
Upvote 0
MickG said:
Try this:-
You need a reference to the numbers used and I have used range("ZZ100") to hold that reference.
If you delete the numbers produces in column "S" and re-run the code you will get a new set of numbers.
Code: 
[COLOR=Navy]Sub[/COLOR] MG14Jun35
[COLOR=Navy]Dim[/COLOR] Rng         [COLOR=Navy]As[/COLOR] Range
[COLOR=Navy]Dim[/COLOR] Dn          [COLOR=Navy]As[/COLOR] Range
[COLOR=Navy]Dim[/COLOR] n           [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long[/COLOR]
[COLOR=Navy]Dim[/COLOR] Txt         [COLOR=Navy]As[/COLOR] [COLOR=Navy]String[/COLOR]
[COLOR=Navy]Dim[/COLOR] Dic         [COLOR=Navy]As[/COLOR] Object
[COLOR=Navy]Dim[/COLOR] Num         [COLOR=Navy]As[/COLOR] [COLOR=Navy]String[/COLOR]
[COLOR=Navy]Set[/COLOR] Rng = Range(Range("B2"), Range("B" & Rows.Count).End(xlUp))
    [COLOR=Navy]Set[/COLOR] Dic = CreateObject("scripting.dictionary")
        Dic.CompareMode = vbTextCompare
            n = IIf(IsEmpty(Range("ZZ100")), 0, Range("ZZ100"))


[COLOR=Navy]For[/COLOR] [COLOR=Navy]Each[/COLOR] Dn [COLOR=Navy]In[/COLOR] Rng
    [COLOR=Navy]If[/COLOR] Dn.Offset(, 17) = vbNullString [COLOR=Navy]Then[/COLOR]
        Txt = Dn & Dn.Offset(, 2) & Dn.Offset(, 10)
            [COLOR=Navy]If[/COLOR] Not Dic.exists(Txt) [COLOR=Navy]Then[/COLOR]
                n = n + 1: Num = n
                Dic.Add Txt, n
            [COLOR=Navy]Else[/COLOR]
                Num = Dic.Item(Txt)
            [COLOR=Navy]End[/COLOR] If
                [COLOR=Navy]With[/COLOR] Dn.Offset(, 17)
                    .NumberFormat = "000"
                    .Value = Num
                [COLOR=Navy]End[/COLOR] With
    [COLOR=Navy]End[/COLOR] If
[COLOR=Navy]Next[/COLOR]
[COLOR=Navy]If[/COLOR] Dic.Count > 0 [COLOR=Navy]Then[/COLOR] Range("ZZ100") = Application.Max(Dic.items)
[COLOR=Navy]End[/COLOR] [COLOR=Navy]Sub[/COLOR]
Regards Mick
Click to expand...

So I need a named range? How do I use ZZ100?

Tahnks for your answer!
 
Upvote 0
Allright, Thank you, have it up and running, I have one more questions:
It fills one entiry column in a table, but the are a lot of empty columns, but it gives them a number, how can I edit the code so that it will not run when for example A2, or A3 is empty?
So it will only give the rows a number which are filled with data.
 
Upvote 0
Hi, You don't need to do anything, it just that the code need to know what the last number used was, and then stores it for reference in "ZZ100", then it knows the next NEW number will be 1 plus that number.
Not knowing exactly how you intend to use the code, its a bit difficult to predict what problems it might cause.
For example if you add more data after you initially run the code, and some of the new data is a duplicate of the data you already have , then if you don't delete the numbers in column "S" you will get the same data with 2 different numbers.
Do you need to cater for that.????

Try this to miss Blanks in Column "A"
Code: 
[COLOR=Navy]Sub[/COLOR] MG14Jun40
[COLOR=Navy]Dim[/COLOR] Rng         [COLOR=Navy]As[/COLOR] Range
[COLOR=Navy]Dim[/COLOR] Dn          [COLOR=Navy]As[/COLOR] Range
[COLOR=Navy]Dim[/COLOR] n           [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long[/COLOR]
[COLOR=Navy]Dim[/COLOR] Txt         [COLOR=Navy]As[/COLOR] [COLOR=Navy]String[/COLOR]
[COLOR=Navy]Dim[/COLOR] Dic         [COLOR=Navy]As[/COLOR] Object
[COLOR=Navy]Dim[/COLOR] Num         [COLOR=Navy]As[/COLOR] [COLOR=Navy]String[/COLOR]
[COLOR=Navy]Set[/COLOR] Rng = Range(Range("B2"), Range("B" & Rows.Count).End(xlUp))
    [COLOR=Navy]Set[/COLOR] Dic = CreateObject("scripting.dictionary")
        Dic.CompareMode = vbTextCompare
            n = IIf(IsEmpty(Range("ZZ100")), 0, Range("ZZ100"))


[COLOR=Navy]For[/COLOR] [COLOR=Navy]Each[/COLOR] Dn [COLOR=Navy]In[/COLOR] Rng
    [COLOR=Navy]If[/COLOR] Dn.Offset(, 17) = vbNullString [COLOR=Navy]Then[/COLOR]
        Txt = Dn & Dn.Offset(, 2) & Dn.Offset(, 10)
          [COLOR=Navy]If[/COLOR] Not Dn.Offset(,-1) = vbNullString [COLOR=Navy]Then[/COLOR]
            [COLOR=Navy]If[/COLOR] Not Dic.exists(Txt) [COLOR=Navy]Then[/COLOR]
                n = n + 1: Num = n
                Dic.Add Txt, n
            [COLOR=Navy]Else[/COLOR]
                Num = Dic.Item(Txt)
            [COLOR=Navy]End[/COLOR] If
                [COLOR=Navy]With[/COLOR] Dn.Offset(, 17)
                    .NumberFormat = "000"
                    .Value = Num
                [COLOR=Navy]End[/COLOR] With
         [COLOR=Navy]End[/COLOR] If
    [COLOR=Navy]End[/COLOR] If
[COLOR=Navy]Next[/COLOR]
[COLOR=Navy]If[/COLOR] Dic.Count > 0 [COLOR=Navy]Then[/COLOR] Range("ZZ100") = Application.Max(Dic.items)
[COLOR=Navy]End[/COLOR] [COLOR=Navy]Sub[/COLOR]
Regards Mick
 
Last edited:
Upvote 0
MickG said:
Hi, You don't need to do anything, it just that the code need to know what the last number used was, and then stores it for reference in "ZZ100", then it knows the next NEW number will be 1 plus that number.
Not knowing exactly how you intend to use the code, its a bit difficult to predict what problems it might cause.
For example if you add more data after you initially run the code, and some of the new data is a duplicate of the data you already have , then if you don't delete the numbers in column "S" you will get the same data with 2 different numbers.
Do you need to cater for that.????

Try this to miss Blanks in Column "A"
Code: 
[COLOR=Navy]Sub[/COLOR] MG14Jun40
[COLOR=Navy]Dim[/COLOR] Rng         [COLOR=Navy]As[/COLOR] Range
[COLOR=Navy]Dim[/COLOR] Dn          [COLOR=Navy]As[/COLOR] Range
[COLOR=Navy]Dim[/COLOR] n           [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long[/COLOR]
[COLOR=Navy]Dim[/COLOR] Txt         [COLOR=Navy]As[/COLOR] [COLOR=Navy]String[/COLOR]
[COLOR=Navy]Dim[/COLOR] Dic         [COLOR=Navy]As[/COLOR] Object
[COLOR=Navy]Dim[/COLOR] Num         [COLOR=Navy]As[/COLOR] [COLOR=Navy]String[/COLOR]
[COLOR=Navy]Set[/COLOR] Rng = Range(Range("B2"), Range("B" & Rows.Count).End(xlUp))
    [COLOR=Navy]Set[/COLOR] Dic = CreateObject("scripting.dictionary")
        Dic.CompareMode = vbTextCompare
            n = IIf(IsEmpty(Range("ZZ100")), 0, Range("ZZ100"))


[COLOR=Navy]For[/COLOR] [COLOR=Navy]Each[/COLOR] Dn [COLOR=Navy]In[/COLOR] Rng
    [COLOR=Navy]If[/COLOR] Dn.Offset(, 17) = vbNullString [COLOR=Navy]Then[/COLOR]
        Txt = Dn & Dn.Offset(, 2) & Dn.Offset(, 10)
          [COLOR=Navy]If[/COLOR] Not Dn.Offset(,-1) = vbNullString [COLOR=Navy]Then[/COLOR]
            [COLOR=Navy]If[/COLOR] Not Dic.exists(Txt) [COLOR=Navy]Then[/COLOR]
                n = n + 1: Num = n
                Dic.Add Txt, n
            [COLOR=Navy]Else[/COLOR]
                Num = Dic.Item(Txt)
            [COLOR=Navy]End[/COLOR] If
                [COLOR=Navy]With[/COLOR] Dn.Offset(, 17)
                    .NumberFormat = "000"
                    .Value = Num
                [COLOR=Navy]End[/COLOR] With
         [COLOR=Navy]End[/COLOR] If
    [COLOR=Navy]End[/COLOR] If
[COLOR=Navy]Next[/COLOR]
[COLOR=Navy]If[/COLOR] Dic.Count > 0 [COLOR=Navy]Then[/COLOR] Range("ZZ100") = Application.Max(Dic.items)
[COLOR=Navy]End[/COLOR] [COLOR=Navy]Sub[/COLOR]
Regards Mick
Click to expand...

Would be nice if data is entered after the code is ran, which has the same values in those columns, is that they get the same number as the others when the code is ran again, and not diffrent ones if you know what I mean
 
Upvote 0
Try this:-
Code: 
[COLOR="Navy"]Sub[/COLOR] MG15Jun35
[COLOR="Navy"]Dim[/COLOR] Rng         [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] Dn          [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] n           [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] Txt         [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String[/COLOR]
[COLOR="Navy"]Dim[/COLOR] Dic         [COLOR="Navy"]As[/COLOR] Object
[COLOR="Navy"]Dim[/COLOR] Num         [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String[/COLOR]
[COLOR="Navy"]Dim[/COLOR] oRng        [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("B2"), Range("B" & Rows.Count).End(xlUp))
[COLOR="Navy"]Set[/COLOR] oRng = Range(Range("ZZ100"), Range("ZZ" & Rows.Count).End(xlUp))
    [COLOR="Navy"]Set[/COLOR] Dic = CreateObject("scripting.dictionary")
        Dic.CompareMode = vbTextCompare
   
   [COLOR="Navy"]If[/COLOR] oRng.Count > 1 [COLOR="Navy"]Then[/COLOR]
        [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] oRng
            Dic(Dn.Value) = Dn.Offset(, 1)
        [COLOR="Navy"]Next[/COLOR] Dn
   [COLOR="Navy"]End[/COLOR] If


n = IIf(oRng.Count > 1, Application.Max(oRng.Offset(, 1)), 0)
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
    [COLOR="Navy"]If[/COLOR] Not Dn.Offset(, -1) = vbNullString [COLOR="Navy"]Then[/COLOR]
        Txt = Dn & Dn.Offset(, 2) & Dn.Offset(, 10)
          [COLOR="Navy"]If[/COLOR] Not Txt = vbNullString [COLOR="Navy"]Then[/COLOR]
            [COLOR="Navy"]If[/COLOR] Not Dic.exists(Txt) [COLOR="Navy"]Then[/COLOR]
                n = n + 1: Num = n
                Dic.Add Txt, n
            [COLOR="Navy"]Else[/COLOR]
                Num = Dic.Item(Txt)
            [COLOR="Navy"]End[/COLOR] If
                [COLOR="Navy"]With[/COLOR] Dn.Offset(, 17)
                    .NumberFormat = "000"
                    .Value = Num
                [COLOR="Navy"]End[/COLOR] With
        
        [COLOR="Navy"]End[/COLOR] If
    [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR]
Range("ZZ:ZZ").ClearContents
Range("ZZ100").Resize(Dic.Count, 2) = Application.Transpose(Array(Dic.keys, Dic.items))
MsgBox "Run"
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
 
Upvote 0
Thanks a lot! seems to work great!
Does it now rember things i've done earlier? So if i put the exact same data in the field, do they get the same number again?
 
Upvote 0
Yes, It remembers it, because the data and numbers previously used are stored in Range "ZZ100" on.
and that previously Data and used numbers are check against the existing data when the code is run.
It not the best solution because the data is stored on the sheet, I suppose you could store it in "text" file somewhere, but I think that is for another day.
 
Upvote 0
You must log in or register to reply here.

Similar threads

R
  • Solved
Sequencing Numbers Not Working
Replies
4
Views
384
DanteAmor
DanteAmor
M
  • Solved
COUNTIF to count cells with conditional formatting
Replies
8
Views
336
Peter_SSs
Peter_SSs
A
  • Question
Matching a number sequence within a group of numbers in a cell
Replies
1
Views
261
FormR
FormR
V
  • Solved
How to Create a Series that Counts Depending on Another Column
Replies
5
Views
203
Fluff
Fluff
C
  • Solved
Transposing Horizontal String
Replies
6
Views
120
c0087
C

Forum statistics

Threads
1,214,971
Messages
6,122,525
Members
449,088
Latest member
RandomExceller01

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top