# Thread: Auto generate a sequence Thanks:  2 Post #5294000 (1)Post #5294089 (1) Likes:  2 Post #5294089 (1)Post #5294000 (1)

1. ## 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  Reply With Quote

2. ## 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```  Reply With Quote

3. ## 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  Reply With Quote

4. ## Re: Auto generate a sequence

Maybe...

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

M.  Reply With Quote

5. ## Re: Auto generate a sequence

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

M.  Reply With Quote

6. ## Re: Auto generate a sequence

Disregard post 4

M.  Reply With Quote

7. ## 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  Reply With Quote

8. ## 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.  Reply With Quote

9. ## 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.  Reply With Quote

10. ## Re: Auto generate a sequence

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

## User Tag List

#### Tags for this Thread

auto, duplicate, l010701698, l010706796, number #### Posting Permissions

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