Auto generate a sequence

DHayes

Board Regular
Joined
Nov 12, 2014
Messages
244
Hi,
I hope someone can help me here. I would like to set a auto contract number. I want to check the CO number if it is duplicate and then add the -n to the contract no. If it is not a duplicate it must be the next sequence in the numbering. Below is an example of what I would like to achieve. I need to do this for 60K CO numbers.

A B
1 CO number Contracts No
2 L010701698 PP19/20/0001-1
3 L010701698 PP19/20/0001-2
4 L010701698 PP19/20/0001-3
5 L010701698 PP19/20/0001-4
6 L010701698 PP19/20/0001-5
7 L010706796 PP19/20/0002-1
8 L010706796 PP19/20/0002-2
9 L010706804 PP19/20/0003
10 L010706887 PP19/20/0004
11 L010707919 PP19/20/0005
 

Excel Facts

How to show all formulas in Excel?
Press Ctrl+` to show all formulas. Press it again to toggle back to numbers. The grave accent is often under the tilde on US keyboards.
Try:
Code:
Sub AddSequNum()
    Application.ScreenUpdating = False
    Dim i As Long, v1 As Variant, x As Long: x = 2
    v1 = Range("A2", Range("A" & Rows.Count).End(xlUp)).Resize(, 2).Value
    With CreateObject("Scripting.Dictionary")
        For i = 1 To UBound(v1, 1)
            If Not .Exists(v1(i, 1)) Then
                .Add v1(i, 1), Nothing
                Cells(i + 1, 2) = Cells(i + 1, 2) & "-" & "1"
                x = 2
            Else
                Cells(i + 1, 2) = Cells(i + 1, 2) & "-" & x
                x = x + 1
            End If
        Next i
    End With
    Application.ScreenUpdating = True
End Sub
 
Upvote 0
Hi Mumps,
Thanks for this but it is not working. below is the output I got.

PP19/20/0001-1
-2
-3
-4
-5
-1
-2
-1
-1
-1

<tbody>
</tbody>
What I need is to output
PP19/20/0001-1
PP19/20/0001-2
PP19/20/0001-3
PP19/20/0001-4
PP19/20/0001-5
PP19/20/0002-1
PP19/20/0002-2
PP19/20/0003
PP19/20/0004
PP19/20/0005

<tbody>
</tbody>
 
Last edited:
Upvote 0
Maybe...

B2 copied down
=IF(COUNTIF(A:A,A2)>1,A2&"-"&COUNTIF(A$2:A2,A2),A2)

M.
 
Last edited:
Upvote 0
oops ... I did not notice you have 60K rows.
Better a macro ...

M.
 
Last edited:
Upvote 0
Try this:-
Code:
[COLOR="Navy"]Sub[/COLOR] MG13Jun55
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Q [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Set[/COLOR] Rng = Range("A2", Range("A" & Rows.Count).End(xlUp))
Application.ScreenUpdating = False
[COLOR="Navy"]With[/COLOR] CreateObject("scripting.dictionary")
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
    [COLOR="Navy"]If[/COLOR] Not .Exists(Dn.Value) [COLOR="Navy"]Then[/COLOR]
        .Add Dn.Value, Array(Dn, 1)
    [COLOR="Navy"]Else[/COLOR]
        Q = .Item(Dn.Value)
            [COLOR="Navy"]If[/COLOR] Q(1) = 1 [COLOR="Navy"]Then[/COLOR]
                Q(0).Offset(, 1) = Q(0).Offset(, 1) & "-" & 1
            [COLOR="Navy"]End[/COLOR] If
            Q(1) = Q(1) + 1
            Dn.Offset(, 1).Value = Dn.Offset(, 1).Value & "-" & Q(1)
        .Item(Dn.Value) = Q
    [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR]
[COLOR="Navy"]End[/COLOR] With
Application.ScreenUpdating = True
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
 
Upvote 0
Maybe...

Assumes the CO Number are grouped

Code:
Sub aTest()
    Dim dic As Object, vdata As Variant, i As Long, s As Variant
    Dim vResult As Variant
    
    Set dic = CreateObject("Scripting.Dictionary")
    dic.CompareMode = vbTextCompare
    
    vdata = Range("A2:A" & Cells(Rows.Count, "A").End(xlUp).Row + 1)
    vResult = Range("B2:B" & Cells(Rows.Count, "A").End(xlUp).Row)
    
    For i = 1 To UBound(vdata) - 1
        If dic.exists(vdata(i, 1)) Then
            dic(vdata(i, 1)) = dic(vdata(i, 1)) + 1
            vResult(i, 1) = "PPO/20/" & Right("0000" & s, 4) & "-" & dic(vdata(i, 1))
        Else
            s = s + 1
            If vdata(i, 1) = vdata(i + 1, 1) Then
                dic(vdata(i, 1)) = 1
                vResult(i, 1) = "PPO/20/" & Right("0000" & s, 4) & "-" & dic(vdata(i, 1))
            Else
                dic(vdata(i, 1)) = ""
                vResult(i, 1) = "PPO/20/" & Right("0000" & s, 4)
            End If
        End If
    Next i
    Range("B2").Resize(i - 1) = vResult
End Sub

M.
 
Upvote 0
oops... typo

Try
Code:
Sub aTest()
    Dim dic As Object, vdata As Variant, i As Long, s As Variant
    Dim vResult As Variant
    
    Set dic = CreateObject("Scripting.Dictionary")
    dic.CompareMode = vbTextCompare
    
    vdata = Range("A2:A" & Cells(Rows.Count, "A").End(xlUp).Row + 1)
    vResult = Range("B2:B" & Cells(Rows.Count, "A").End(xlUp).Row)
    
    For i = 1 To UBound(vdata) - 1
        If dic.exists(vdata(i, 1)) Then
            dic(vdata(i, 1)) = dic(vdata(i, 1)) + 1
            vResult(i, 1) = "PP[COLOR=#ff0000]19[/COLOR]/20/" & Right("0000" & s, 4) & "-" & dic(vdata(i, 1))
        Else
            s = s + 1
            If vdata(i, 1) = vdata(i + 1, 1) Then
                dic(vdata(i, 1)) = 1
                vResult(i, 1) = "PP[COLOR=#ff0000]19[/COLOR]/20/" & Right("0000" & s, 4) & "-" & dic(vdata(i, 1))
            Else
                dic(vdata(i, 1)) = ""
                vResult(i, 1) = "PP[COLOR=#ff0000]19[/COLOR]/20/" & Right("0000" & s, 4)
            End If
        End If
    Next i
    Range("B2").Resize(i - 1) = vResult
End Sub

M.
 
Upvote 0

Forum statistics

Threads
1,213,549
Messages
6,114,261
Members
448,558
Latest member
aivin

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