Auto generate a sequence

[DHayes]

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

 

[mumps]

Try:

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

 

[DHayes]

Hi Mumps,
Thanks for this but it is not working. below is the output I got.

[TABLE="width: 144"]
<tbody>[TR]
[TD]PP19/20/0001-1[/TD]
[/TR]
[TR]
[TD="align: right"]-2[/TD]
[/TR]
[TR]
[TD="align: right"]-3[/TD]
[/TR]
[TR]
[TD="align: right"]-4[/TD]
[/TR]
[TR]
[TD="align: right"]-5[/TD]
[/TR]
[TR]
[TD="align: right"]-1[/TD]
[/TR]
[TR]
[TD="align: right"]-2[/TD]
[/TR]
[TR]
[TD="align: right"]-1[/TD]
[/TR]
[TR]
[TD="align: right"]-1[/TD]
[/TR]
[TR]
[TD="align: right"]-1[/TD]
[/TR]
</tbody>[/TABLE]
What I need is to output
[TABLE="width: 144"]
<tbody>[TR]
[TD]PP19/20/0001-1[/TD]
[/TR]
[TR]
[TD]PP19/20/0001-2[/TD]
[/TR]
[TR]
[TD]PP19/20/0001-3[/TD]
[/TR]
[TR]
[TD]PP19/20/0001-4[/TD]
[/TR]
[TR]
[TD]PP19/20/0001-5[/TD]
[/TR]
[TR]
[TD]PP19/20/0002-1[/TD]
[/TR]
[TR]
[TD]PP19/20/0002-2[/TD]
[/TR]
[TR]
[TD]PP19/20/0003[/TD]
[/TR]
[TR]
[TD]PP19/20/0004[/TD]
[/TR]
[TR]
[TD]PP19/20/0005[/TD]
[/TR]
</tbody>[/TABLE]

 

[Marcelo Branco]

Maybe...

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

M.

 

[Marcelo Branco]

oops ... I did not notice you have 60K rows.
Better a macro ...

M.

 

[Marcelo Branco]

Disregard post 4

M.

 

[MickG]

Try this:-

[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

 

[Marcelo Branco]

Maybe...

Assumes the CO Number are grouped

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.

 

[Marcelo Branco]

oops... typo

Try

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.

 

[DHayes]

Thank you Marcelo,
This did the job perfectly. It is appreciated.