Generate sequential number based on name

dellzy

Board Regular
Joined
Apr 24, 2013
Messages
146
Hi Excel Experts,

Am trying to find a macro that auto-generate doc ref number sequentially (at the last 3 digits on the right) based on same student's name everytime I click a button. (numbers in the middle are generated randomly).
Expected output :
Name RefNum (cell A2)
Darwin IPK-00931867-001
Maria IPK-00056091-005
Adam IPK-01968304-003
Charles IPK-02091832-002
Darwin IPK-01111532-002
Adam IPK-00099018-004
Maria IPK-00328949-006
Adam IPK-00931867-005

Please advise if I need to maintain a list to allow the macro generator can identify the repetitive name to let it be able to populate sequential numbers.

Appreciate your help.

Thank you very much in advance.

DZ
 

Excel Facts

Format cells as date
Select range and press Ctrl+Shift+3 to format cells as date. (Shift 3 is the # sign which sort of looks like a small calendar).
Double click on cell in column B to add next ref
(conversion to proper case forces consistency)

BEFORE

Excel 2016 (Windows) 32 bit
A
B
1
NameRef
2
DarwinIPK-00931867-001
3
MariaIPK-00056091-005
4
AdamIPK-01968304-003
5
CharlesIPK-02091832-002
6
DarwinIPK-01111532-002
7
AdamIPK-00099018-004
8
MariaIPK-00328949-006
9
AdamIPK-00931867-005
10
Maria
11
Adam
12
John
Sheet: Sheet1

AFTER

Excel 2016 (Windows) 32 bit
A
B
1
NameRef
2
DarwinIPK-00931867-001
3
MariaIPK-00056091-005
4
AdamIPK-01968304-003
5
CharlesIPK-02091832-002
6
DarwinIPK-01111532-002
7
AdamIPK-00099018-004
8
MariaIPK-00328949-006
9
AdamIPK-00931867-005
10
MariaIPK-09619532-007
11
AdamIPK-08626193-006
12
JohnIPK-07904800-001
Sheet: Sheet1

Put this in sheet module
(right click on sheet tab \ View Code \ paste code in that window \ {ALT}{F11} to go to Excel window)
Code:
Option Explicit

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Not Intersect(Target, Range("B:B")) Is Nothing Then
        Cancel = True
        Target.Offset(, -1) = WorksheetFunction.Proper(Target.Offset(, -1))
        Target = GetNextRef(Target.Offset(, -1))
    End If
End Sub

Private Function GetNextRef(cel As Range) As String
'variables
    Dim RndNo As Long, RefNo As Long, Nm As Range, maxNo As Integer, thisNo As Integer
'random no
    RndNo = Round(Rnd() * 10000000, 0)
'last 3 characters
    For Each Nm In Range("A2", Range("A" & Rows.Count).End(xlUp))
        If Not Nm.Address = cel.Address Then                                    'ignore cell we are trying to update
            If Len(Nm.Offset(, 1)) = 16 Then thisNo = Right(Nm.Offset(, 1), 3)  'validity check on other ref nos
            If Nm = cel And thisNo > maxNo Then maxNo = thisNo                  'is this number bigger?
        End If
    Next Nm
    RefNo = maxNo + 1
'put it all together
    GetNextRef = "IPK-" & Format(RndNo, "00000000") & "-" & Format(RefNo, "000")
End Function
 
Upvote 0
Hi Yongle,

First of all tqvm for your effort to contribute solution. I tried it out and it did populate the ref number upon double-click the cell in column B next to the name. However, the ref number seems not increase for repetitive name (I have copied the name in cell A2 and pasted into A3 and A4 to ensure each is identical input). Does it have anything to do with the Excel version am using? FYI, I'm still on Excel 2010.

Appreciate your advice.

Thank you very much in advance.

DZ
 
Upvote 0
Excel version is not relevant
But I do not understand your problem :confused: :confused:
- Are you saying that it does not work if the same name is on consecutive lines ?

It works for me (see below) - I added the name several times and double-clicked on each cell in turn

Or are you doing something different?


Excel 2016 (Windows) 32 bit
A
B
1
NameRef
2
DarwinIPK-00931867-001
3
MariaIPK-00056091-005
4
AdamIPK-01968304-003
5
CharlesIPK-02091832-002
6
DarwinIPK-01111532-002
7
AdamIPK-00099018-004
8
MariaIPK-00328949-006
9
AdamIPK-00931867-005
10
MariaIPK-09619532-007
11
AdamIPK-08626193-006
12
JohnIPK-07904800-001
13
JohnIPK-07055475-002
14
JohnIPK-05334240-003
15
JohnIPK-05795186-004
16
JohnIPK-02895625-005
17
JohnIPK-03019480-006
Sheet: Sheet1
 
Upvote 0
Hi Yongle,

Very sorry for the trouble. I have tested your macros on another worksheet and it did worked exactly as I wanted. Which means you understood my requirements initially. Just that I came across a problem when I have changed Name input to be in column L and starts from cell L9 downwards while the RefNum starts at column T from cell T9 downwards.

I suspect that the vba macros at the "Offset" part is affected when I changed the input and the expected output. I tried to adjust them thinking that L is column number 8 while T is column number 20 but still doesn't work, so I guess my understanding is wrong about the numbers you stated in the brackets after "Offset". I supposed I would still seek your kind help to modify for me accordingly or maybe you can explain how you define the "Offset(,-1)" and "Offset(,1)" so that I can change necessarily in future. Or maybe there are some other things I need to change?

Thanks a lot in advance.

DZ
 
Upvote 0
Hi Yongle,

Very sorry for the trouble. I have tested your macros on another worksheet and it did worked exactly as I wanted. Which means you understood my requirements initially. Just that I came across a problem when I have changed Name input to be in column L and starts from cell L9 downwards while the RefNum starts at column T from cell T9 downwards.

I suspect that the vba macros at the "Offset" part is affected when I changed the input and the expected output. I tried to adjust them thinking that L is column number 8 while T is column number 20 but still doesn't work, so I guess my understanding is wrong about the numbers you stated in the brackets after "Offset". I supposed I would still seek your kind help to modify for me accordingly or maybe you can explain how you define the "Offset(,-1)" and "Offset(,1)" so that I can change necessarily in future. Or maybe there are some other things I need to change?

Thanks a lot in advance.

DZ

Sorry, what I meant earlier by column L is number 8 was actually at position -8 when counting from column T.
 
Upvote 0
OK - I will post amended code for you shortly and I will add some explanation
 
Upvote 0
I entered all the names first and double-clicked on each cell in column T in succession
This is what I get

Excel 2016 (Windows) 32 bit
K
L
M
N
O
P
Q
R
S
T
1
..
2
.
3
.
4
.
5
.
6
.
7
.
8
Name.......Ref
9
DarwinIPK-02782800-001
10
MariaIPK-01604415-001
11
AdamIPK-01628216-001
12
CharlesIPK-06465871-001
13
DarwinIPK-04100732-002
14
AdamIPK-04127668-002
15
MariaIPK-07127305-002
16
AdamIPK-03262062-003
17
MariaIPK-06331789-003
18
AdamIPK-02075611-004
19
JohnIPK-01860135-001
20
JohnIPK-05833590-002
21
JohnIPK-00807146-003
22
JohnIPK-04579715-004
23
JohnIPK-09057298-005
24
JohnIPK-02613683-006
Sheet: Sheet4

CODE (including extra notes)
Code:
[COLOR=#006400][I]'The TARGET is the cell we are clicking in (in column T)
'We want the next reference for NAME (which is in column L)
'Column L is 8 columns to left of T  ie OFFSET(0 rows,-8 columns)[/I][/COLOR]


Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Target.Row < 9 Then Exit Sub
    If Not Intersect(Target, Range("T:T")) Is Nothing Then
        Cancel = True
        Target.Offset(, -8) = WorksheetFunction.Proper(Target.Offset(0, -8))
        Target = GetNextRef(Target.Offset(, -8))
    End If
End Sub

Private Function GetNextRef(cel As Range) As String
[I][COLOR=#006400]'variables[/COLOR][/I]
    Dim RndNo As Long, RefNo As Long, Nm As Range, maxNo As Integer, thisNo As Integer
[I][COLOR=#006400]'generate a random no[/COLOR][/I]
    RndNo = Round(Rnd() * 10000000, 0)
[I][COLOR=#006400]'last 3 characters[/COLOR][/I]
    For Each Nm In Range("[COLOR=#ff0000]L9[/COLOR]", Range("[COLOR=#ff0000]L[/COLOR]" & Rows.Count).End(xlUp))
[I][COLOR=#006400]    'ignore cell we are trying to update[/COLOR][/I]
        If Not Nm.Address = cel.Address Then
[I][COLOR=#006400]            'get the 3 digit value from column L if it is valid (otherwise assume =0)[/COLOR][/I]
            If Len(Nm.Offset(0, 8)) = 16 Then thisNo = Right(Nm.Offset(0, 8), 3) Else thisNo = 0
[I][COLOR=#006400]            'compare thisNo against previous maxNo and replace maxxNo if required[/COLOR][/I]
            If Nm = cel And thisNo > maxNo Then maxNo = thisNo
        End If
    Next Nm
[I][COLOR=#006400]    'having determined the actual maximum for this name, add 1 to it[/COLOR][/I]
    RefNo = maxNo + 1
[I][COLOR=#006400]'format the various segments as required and concatenate everything[/COLOR][/I]
    GetNextRef = "IPK-" & Format(RndNo, "00000000") & "-" & Format(RefNo, "000")
End Function
 
Upvote 0
You can test the above and it should do what you want

I have just spotted a minor issue with this line
Code:
If Len(Nm.Offset(0, 8)) = 16 Then thisNo = Right(Nm.Offset(0, 8), 3) Else thisNo = 0

The code will fail if Right(Nm.Offset(0, 8), 3) does not equate to a number
- I know it always should but users do accidentally damage data and the code must be able to handle it

I will update the thread shortly
 
Last edited:
Upvote 0
Here is an update to deal with what I said in post#10
I have added a variable and an extra test, which has necessitated a few other minor tweaks in the code - so delete previous version & copy/paste the WHOLE of the code

Code:
'The TARGET is the cell we are clicking in (in column T)
'We want the next reference for NAME (which is in column L)
'Column L is 8 columns to left of T  ie OFFSET(0 rows,-8 columns)


Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Target.Row < 9 Then Exit Sub
    If Not Intersect(Target, Range("T:T")) Is Nothing Then
        Cancel = True
        Target.Offset(, -8) = WorksheetFunction.Proper(Target.Offset(0, -8))
        Target = GetNextRef(Target.Offset(, -8))
    End If
End Sub

Private Function GetNextRef(cel As Range) As String
'variables
    Dim RndNo As Long, RefNo As Long, Nm As Range, maxNo As Integer, thisNo As Integer, Check As Variant
'generate a random no
    RndNo = Round(Rnd() * 10000000, 0)
'last 3 characters
    For Each Nm In Range("L9", Range("L" & Rows.Count).End(xlUp))
    'ignore cell we are trying to update
        If Not Nm.Address = cel.Address Then
            'get the 3 digit value from column L if it is valid (otherwise assume =0)
            If Len(Nm.Offset(0, 8)) = 16 Then
                [COLOR=#ff0000]Check = Right(Nm.Offset(0, 8), 3)[/COLOR]
                [COLOR=#ff0000]If IsNumeric(Check) Then thisNo = Check Else thisNo = 0[/COLOR]
            End If
            'compare thisNo against previous maxNo and replace maxxNo if required
            If Nm = cel And thisNo > maxNo Then maxNo = thisNo
        End If
    Next Nm
    'having determined the actual maximum for this name, add 1 to it
    RefNo = maxNo + 1
'put it all together
'format the various segments as required and concatenate everything
    GetNextRef = "IPK-" & Format(RndNo, "00000000") & "-" & Format(RefNo, "000")
End Function
 
Last edited:
Upvote 0

Forum statistics

Threads
1,213,544
Messages
6,114,249
Members
448,556
Latest member
peterhess2002

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