Generate sequential number based on name

D

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
 
Sort by date Sort by votes
Yongle said:
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
Click to expand...

Hi Yongle, i tried your latest code but it seems that RefNo being generated sequentially regardless the frequency of the same name.
 
Upvote 0

Excel Facts

How to change case of text in Excel?
Use =UPPER() for upper case, =LOWER() for lower case, and =PROPER() for proper case. PROPER won't capitalize second c in Mccartney
Yongle said:
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
[COLOR=[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FFFFFF]#FFFFFF[/URL] ]K[/COLOR]​
[COLOR=[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FFFFFF]#FFFFFF[/URL] ]L[/COLOR]​
[COLOR=[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FFFFFF]#FFFFFF[/URL] ]M[/COLOR]​
[COLOR=[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FFFFFF]#FFFFFF[/URL] ]N[/COLOR]​
[COLOR=[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FFFFFF]#FFFFFF[/URL] ]O[/COLOR]​
[COLOR=[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FFFFFF]#FFFFFF[/URL] ]P[/COLOR]​
[COLOR=[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FFFFFF]#FFFFFF[/URL] ]Q[/COLOR]​
[COLOR=[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FFFFFF]#FFFFFF[/URL] ]R[/COLOR]​
[COLOR=[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FFFFFF]#FFFFFF[/URL] ]S[/COLOR]​
[COLOR=[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FFFFFF]#FFFFFF[/URL] ]T[/COLOR]​
[COLOR=[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FFFFFF]#FFFFFF[/URL] ]1[/COLOR]​
..
[COLOR=[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FFFFFF]#FFFFFF[/URL] ]2[/COLOR]​
.
[COLOR=[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FFFFFF]#FFFFFF[/URL] ]3[/COLOR]​
.
[COLOR=[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FFFFFF]#FFFFFF[/URL] ]4[/COLOR]​
.
[COLOR=[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FFFFFF]#FFFFFF[/URL] ]5[/COLOR]​
.
[COLOR=[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FFFFFF]#FFFFFF[/URL] ]6[/COLOR]​
.
[COLOR=[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FFFFFF]#FFFFFF[/URL] ]7[/COLOR]​
.
[COLOR=[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FFFFFF]#FFFFFF[/URL] ]8[/COLOR]​
Name.......Ref
[COLOR=[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FFFFFF]#FFFFFF[/URL] ]9[/COLOR]​
DarwinIPK-02782800-001
[COLOR=[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FFFFFF]#FFFFFF[/URL] ]10[/COLOR]​
MariaIPK-01604415-001
[COLOR=[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FFFFFF]#FFFFFF[/URL] ]11[/COLOR]​
AdamIPK-01628216-001
[COLOR=[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FFFFFF]#FFFFFF[/URL] ]12[/COLOR]​
CharlesIPK-06465871-001
[COLOR=[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FFFFFF]#FFFFFF[/URL] ]13[/COLOR]​
DarwinIPK-04100732-002
[COLOR=[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FFFFFF]#FFFFFF[/URL] ]14[/COLOR]​
AdamIPK-04127668-002
[COLOR=[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FFFFFF]#FFFFFF[/URL] ]15[/COLOR]​
MariaIPK-07127305-002
[COLOR=[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FFFFFF]#FFFFFF[/URL] ]16[/COLOR]​
AdamIPK-03262062-003
[COLOR=[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FFFFFF]#FFFFFF[/URL] ]17[/COLOR]​
MariaIPK-06331789-003
[COLOR=[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FFFFFF]#FFFFFF[/URL] ]18[/COLOR]​
AdamIPK-02075611-004
[COLOR=[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FFFFFF]#FFFFFF[/URL] ]19[/COLOR]​
JohnIPK-01860135-001
[COLOR=[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FFFFFF]#FFFFFF[/URL] ]20[/COLOR]​
JohnIPK-05833590-002
[COLOR=[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FFFFFF]#FFFFFF[/URL] ]21[/COLOR]​
JohnIPK-00807146-003
[COLOR=[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FFFFFF]#FFFFFF[/URL] ]22[/COLOR]​
JohnIPK-04579715-004
[COLOR=[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FFFFFF]#FFFFFF[/URL] ]23[/COLOR]​
JohnIPK-09057298-005
[COLOR=[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FFFFFF]#FFFFFF[/URL] ]24[/COLOR]​
JohnIPK-02613683-006

<tbody>
</tbody>
Sheet: Sheet4

<tbody>
</tbody>

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
Click to expand...

But before you posted the latest code with extra error handling, I tested with this one and it works perfectly.
 
Upvote 0
OK if it works - use the previous version
 
Upvote 0
Here is a way to make sure that all cells contain valid entries

Code: 
Sub CallFunction()
    Dim cel As Range, msg As String
    For Each cel In Range("T9", Range("T" & Rows.Count).End(xlUp))
        If TestValidity(cel) = False Then msg = msg & vbCr & cel & vbTab & cel.Address(0, 0)
    Next
    MsgBox msg
End Sub
Private Function TestValidity(cel As Range) As Boolean
    Dim A, B, C, D
    TestValidity = True
    If Len(cel) = 16 Then
        A = Left(cel, 4)
        B = Mid(cel, 5, 8)
        C = Mid(cel, 13, 1)
        D = Right(cel, 3)
        If Not A = "IPK-" Then TestValidity = False
        If Not IsNumeric(B) Then TestValidity = False
        If Not C = "-" Then TestValidity = False
        If Not IsNumeric(D) Then TestValidity = False
    Else
        TestValidity = False
    End If
End Function
 
Upvote 0
You must log in or register to reply here.

Similar threads

M
  • Solved
Macros to generate sequential numbers based on value entered
Replies
5
Views
1K
DanteAmor
DanteAmor
P
  • Question
VBA code to auto generate the next sequential number?
Replies
4
Views
32K
CampbellC
C
D
  • Question
Macro to open sheets, rename sheets as number plus event name and then close with save as new name
Replies
2
Views
3K
drhatmrexcel
D

Forum statistics

Threads
1,214,652
Messages
6,120,746
Members
448,989
Latest member
mariah3

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