Excel VBA : Auto Generating Unique Number for each row

Question

I got a requirement for auto filling the row with unique number starting from some value(say 1000).

• The sheet has 2 columns.

• When ever I fill a value in 2nd column in each row the first column should auto filled.

• I have filled 3 rows(1000,1001,1002).

• Now if i delete the middle row that has the auto generated value as 1001, the row that was initially with the value 1002 gets automatically updated to 1001.

• But according to my requirement the value should remain unique(it should remain as 1002).

Formula that i used is:

=IF(B2<>"",COUNTA($B$2:B2)+999,"")

My excel is like this before deleting the value:

Test_Case_Id    Name
1000             a
1001             b
1002             c

After deleting the middle row it becomes:

Test_Case_Id    Name
1000             a
1001             c

Expected Result:

Test_Case_Id    Name
1000             a
1002             c

Please help me in this.

Thanks, Vevek

Answer 1

You tagged with VBA, but you are not using VBA. Formulas that count rows or use the current row number will always update when the sheet re-calculcates.

In order to achieve what you describe, you really need VBA. A simple worksheet change event should do it. Think along the lines of

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

Copy the code, right-click the sheet tab, select "view code" and paste into the code window.

Here's a screenshot of before and after deleting row with ID 1002:

Answer 2

Sub abc()
Dim a As Integer
Dim b As Integer
Dim i As Integer
Dim z As Integer

i = 1
Set sh = ThisWorkbook.Sheets("Sheet1") 'instead of sheet1 you can add name of your sheet
Dim k As Long
k = 2
Set rn = sh.UsedRange
k = rn.Rows.Count

Cells(1, 1).Value = 1001


Do Until i = k

b = (Cells(i, 1).Value)
a = b + 1
i = i + 1

Cells(i, 1).Value = a

Loop
End Sub

Not sure if you need a macro. You can add this macro to your file. Even after you delete the cell, once you run again the macro, the current cell value will be the value of the above cell plus one, so everthing will be according to series. Thanks