Auto unique numbering

[Pat]

I want a unique number automatically inserted using the Worksheet_Change
event. When a cell in column D contains a value column E will automatically
display a unique 13 digit number which is incremented by one. The worksheet
will be sorted regularly, so taking away the worry of knowing what the last
number used to avoid duplicates is vital.

Anyone got the know-how on this?
Many thanks!
Pat

 

[Frank Kabel]

Hi
try
Private Sub Worksheet_Change(ByVal Target As Range)
Dim counter
If Target.Cells.Count > 1 Then Exit Sub
If Target.Column <> 4 Then Exit Sub
On Error GoTo errhandler
Application.EnableEvents = False
With Target
If .Value = "" Then
.Offset(0, 1).ClearContents
Else
counter = Application.WorksheetFunction.Max(Me.Range("E:E")) + 1
.Offset(0, 1).NumberFormat = "0000000000000"
.Offset(0, 1).Value = counter
End If
End With

errhandler:
Application.EnableEvents = True
End Sub

 

[Pat]

Hi Frank,
Your code worked beautifully. The only thing I need cleared up is if the
Offset is change as follows:

.Offset(0, 5).ClearContents
Else
counter = Application.WorksheetFunction.Max(Me.Range("E:E")) + 1
.Offset(0, 5).NumberFormat = "0000000000000"
.Offset(0, 5).Value = counter

incrementing does not take place, why would that be?

Regards and many thanks.
Pat

 

[Frank Kabel]

Hi
you're inserting the values in column I?. If yes change the line
counter = Application.WorksheetFunction.Max(Me.Range("E:E")) + 1

to
counter = Application.WorksheetFunction.Max(Me.Range("I:I")) + 1