Auto generate a sequence
Page 1 of 2 12 LastLast
Results 1 to 10 of 17

Thread: Auto generate a sequence

  1. #1
    Board Regular
    Join Date
    Nov 2014
    Location
    South Africa
    Posts
    241
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Auto generate a sequence

    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

  2. #2
    Board Regular mumps's Avatar
    Join Date
    Apr 2012
    Location
    Toronto, Canada
    Posts
    8,087
    Post Thanks / Like
    Mentioned
    85 Post(s)
    Tagged
    5 Thread(s)

    Default Re: Auto generate a sequence

    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
    Practice makes perfect. I'm very far from perfect so I'm still practising.

  3. #3
    Board Regular
    Join Date
    Nov 2014
    Location
    South Africa
    Posts
    241
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Auto generate a sequence

    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
    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
    Last edited by DHayes; Jun 13th, 2019 at 10:42 AM.

  4. #4
    MrExcel MVP
    Join Date
    Aug 2010
    Location
    Rio de Janeiro BRAZIL
    Posts
    16,228
    Post Thanks / Like
    Mentioned
    19 Post(s)
    Tagged
    8 Thread(s)

    Default Re: Auto generate a sequence

    Maybe...

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

    M.
    Last edited by Marcelo Branco; Jun 13th, 2019 at 10:59 AM.

  5. #5
    MrExcel MVP
    Join Date
    Aug 2010
    Location
    Rio de Janeiro BRAZIL
    Posts
    16,228
    Post Thanks / Like
    Mentioned
    19 Post(s)
    Tagged
    8 Thread(s)

    Default Re: Auto generate a sequence

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

    M.
    Last edited by Marcelo Branco; Jun 13th, 2019 at 11:02 AM.

  6. #6
    MrExcel MVP
    Join Date
    Aug 2010
    Location
    Rio de Janeiro BRAZIL
    Posts
    16,228
    Post Thanks / Like
    Mentioned
    19 Post(s)
    Tagged
    8 Thread(s)

    Default Re: Auto generate a sequence

    Disregard post 4

    M.

  7. #7
    MrExcel MVP
    Join Date
    Jan 2008
    Posts
    14,820
    Post Thanks / Like
    Mentioned
    25 Post(s)
    Tagged
    11 Thread(s)

    Default Re: Auto generate a sequence

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

  8. #8
    MrExcel MVP
    Join Date
    Aug 2010
    Location
    Rio de Janeiro BRAZIL
    Posts
    16,228
    Post Thanks / Like
    Mentioned
    19 Post(s)
    Tagged
    8 Thread(s)

    Default Re: Auto generate a sequence

    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.

  9. #9
    MrExcel MVP
    Join Date
    Aug 2010
    Location
    Rio de Janeiro BRAZIL
    Posts
    16,228
    Post Thanks / Like
    Mentioned
    19 Post(s)
    Tagged
    8 Thread(s)

    Default Re: Auto generate a sequence

    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) = "PP19/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) = "PP19/20/" & Right("0000" & s, 4) & "-" & dic(vdata(i, 1))
                Else
                    dic(vdata(i, 1)) = ""
                    vResult(i, 1) = "PP19/20/" & Right("0000" & s, 4)
                End If
            End If
        Next i
        Range("B2").Resize(i - 1) = vResult
    End Sub
    M.

  10. #10
    Board Regular
    Join Date
    Nov 2014
    Location
    South Africa
    Posts
    241
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Auto generate a sequence

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

Some videos you may like

User Tag List

Tags for this Thread

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •