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:

[TABLE="width: 500"]
<tbody>[TR]
[TD]Column B (Truck)[/TD]
[TD]Column D (EmployeeNR)[/TD]
[TD]Column L (Date)[/TD]
[TD]Column S (Unique Number)[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]5[/TD]
[TD]14-6-2014[/TD]
[TD]0001[/TD]
[/TR]
[TR]
[TD]3[/TD]
[TD]4[/TD]
[TD]14-6-2014[/TD]
[TD]0002[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]5[/TD]
[TD]14-6-2014[/TD]
[TD]0001[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]4[/TD]
[TD]14-6-2014[/TD]
[TD]0003[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]6[/TD]
[TD]14-6-2014[/TD]
[TD]0004[/TD]
[/TR]
[TR]
[TD]3[/TD]
[TD]4[/TD]
[TD]14-6-2014[/TD]
[TD]0002[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]5[/TD]
[TD]14-6-2014[/TD]
[TD]0001[/TD]
[/TR]
</tbody>[/TABLE]

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

Did you know Excel offers Filter by Selection?
Add the AutoFilter icon to the Quick Access Toolbar. Select a cell containing Apple, click AutoFilter, and you will get all rows with Apple
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

L
  • Solved
Transposing data vertically to horizontally for duplicate vs non duplicate data
Replies
2
Views
235
lizsunnysideup
L
N
  • Solved
Formula to consolidate Data and remove entries with no data in that year
2
Replies
10
Views
315
Newbie73
N
S
  • Solved
Index Match w/ ISNUMBER(FIND ?
Replies
2
Views
153
SnKeaK
S
BrettOlbrys1
  • Solved
Count Unique Values Based on Multiple Criteria
Replies
6
Views
436
BrettOlbrys1
BrettOlbrys1
M
  • Question Question
Excel to create new rows of data in a table
Replies
1
Views
74
mumps
mumps

Forum statistics

Threads
1,223,234
Messages
6,170,891
Members
452,366
Latest member
TePunaBloke

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