CODEWITHSUNDEEP
vbaexcelautonumber
hanae
hanae

Reputation: 11

Excel VBA : Auto numbering

I'm creating a database on Excel, and encountered some problems as I tried to assign auto number to each row.

Requirements are:

  1. generate auto number to each row(on the column A) when column B is not blank.
  2. the number should be unique and must always be connected to the contents of the same row even when the column is sorted or when new rows are inserted, etc.
  3. when a new row is inserted (anywhere on the same column), a new number should be assigned (the newest number should be the biggest number) if
  4. possible, the auto number should have a prefix, and number should be displayed in four digits (e.g. 0001, 0011)

I have tried some VBA codes I found from other people's questions (e.g. Excel VBA : Auto Generating Unique Number for each row).

So far, the code below has worked the best, but the requirement (3) and (4) couldn't be solved by that code.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim maxNumber
If Not Intersect(Target, Range("B:B")) Is Nothing Then
' don't run when more than one row is changed
    If Target.Rows.Count > 1 Then Exit Sub
' if column A in the current row has a value, don't run
    If Cells(Target.Row, 1) > 0 Then Exit Sub
' get the highest number in column A, then add 1 and write to the
' current row, column A
    maxNumber = Application.WorksheetFunction.Max(Range("A:A"))
    Target.Offset(0, -1) = maxNumber + 1
End If
End Sub

I'm short of the knowledge of VBA and I hope someone could help me this. Many thanks.

Upvotes: 1

Views: 11454

Answers (2)

T.M.
T.M.

Reputation: 9948

Alternative via CustomDocumentProperties

Instead of using a hidden sheet as proposed by @TimWilliams, one can assign incremented values to a user defined custom document property (CDP), naming it e.g. "InvNo" holding the newest invoice number. The cdp remain stored in the saved workbook.

The function below gets the current number saved to this workbook related property and returns the next number by adding 1 to the current value. It uses a help procedure RefreshCDP to assign the new value (could be used of course independantly to reset values programmaticaly to any other value). - If the cdp name isn't passed as (optional) argument, the function assumes "InvNo" by default.

Note that code requires some error handling to check if the cdp exists.

Example call

Dim InvoiceNumber as Long
InvoiceNumber = NextNumber("InvNo")    ' or simply: NextNumber

Public Function NextNumber(Optional CDPName As String = "InvNo") As Long

    'a) get current cdp value
    Dim curVal As Long
    On Error Resume Next
    curVal = ThisWorkbook.CustomDocumentProperties(CDPName)
    If Err.Number <> 0 Then Err.Clear            ' not yet existing, results in curVal of 0

    'b) increment current cdp value by one to simulate new value
    Dim newVal As Long
    newVal = curVal + 1
    'Debug.Print "Next " & CDPName & " will be: " & newVal

    'c) assign new value to custom document property
    RefreshCDP CDPName, newVal, msoPropertyTypeNumber
    'Debug.Print "New  " & CDPName & " now  is: " & ThisWorkbook.CustomDocumentProperties(CDPName)
    NextNumber = newVal
    
End Function

Help procedure RefreshCDP

Sub RefreshCDP(CDPName As String, _
    newVal As Variant, docType As Office.MsoDocProperties)
    On Error Resume Next
    ThisWorkbook.CustomDocumentProperties(CDPName).Value = newVal
    'If cdp doesn't exist yet, create it (plus adding the new value)
    If Err.Number > 0 Then
        ThisWorkbook.CustomDocumentProperties.Add _
            Name:=CDPName, _
            LinkToContent:=False, _
            Type:=docType, _
            Value:=newVal
    End If
End Sub

Related links

Upvotes: 2

Tim Williams
Tim Williams

Reputation: 166316

Do not use Max() to find the next number - use instead a hidden sheet or name to store the current number, and increment it each time a new Id is required.

For example:

Public Function NextNumber(SequenceName As String)
    Dim n As Name, v
    On Error Resume Next
    Set n = ThisWorkbook.Names(SequenceName)
    On Error GoTo 0

    If n Is Nothing Then
        'create the name if it doesn't exist
        ThisWorkbook.Names.Add SequenceName, RefersTo:=2
        v = 1
    Else
        'increment the current value
        v = Replace(n.RefersTo, "=", "")
        n.RefersTo = v + 1
    End If
    NextNumber = v
End Function

This allows you to use multiple different sequences as long as you give each one a distinct name.

Dim seq
seq = NextNumber("seqOne")
'etc

Upvotes: 1

Related Questions