Unique ID for new userform's entries

[VanillaSky]

Hi.

I want my userform to insert unique id for every new entry starting from 1. Could you please take a look at the code below and advise how to edit it to add this feature?

Private Sub OutPutData()
    Dim NextRow As Range
     
    Set NextRow = Worksheets("List").Cells(Rows.Count, "B").End(xlUp).Offset(1).Resize(1, 6)
    With Me
    
        NextRow.Cells(1) = .TextBox_PI_Case
        NextRow.Cells(2) = .TextBox_Company_Name
        NextRow.Cells(3) = "NEW"
        NextRow.Cells(4) = .TextBox_RoR
        NextRow.Cells(5) = .TextBox_Comments
        NextRow.Cells(6) = Date

    End With
End Sub


Private Sub ClearData() 
    With Me
        .TextBox_PI_Case = ""
        .TextBox_Company_Name = ""
        .TextBox_RoR = ""
        .TextBox_Comments = ""
        .TextBox_PI_Case.SetFocus
    End With
End Sub


 
Sub CommandButton_Submit_Click()
     
     'check for a Name number
    If Trim(Me.TextBox_Company_Name.Value) = "" Then
        Me.TextBox_Company_Name.SetFocus
        MsgBox "Please complete the form"
        Exit Sub
    End If
     
     'copy the data to the database
    OutPutData
     
    MsgBox "Data added", vbOKOnly + vbInformation, "Data Added"
     
     'clear the data
    ClearData
     
End Sub


Private Sub CommandButton_Cancel_Click()
Unload Me
End Sub

 

[dmt32]

Hi,
one way would to use Row number from your NextRow variable

Private Sub OutPutData()
    Dim NextRow As Range
     
    Set NextRow = Worksheets("List").Cells(Rows.Count, "B").End(xlUp).Offset(1).Resize(1, 6)
    With Me
    
        NextRow.Cells(1) = .TextBox_PI_Case
        NextRow.Cells(2) = .TextBox_Company_Name
        NextRow.Cells(3) = "NEW"
        NextRow.Cells(4) = .TextBox_RoR
        NextRow.Cells(5) = .TextBox_Comments
        NextRow.Cells(6) = Date
        
        With NextRow.Cells(, 7)
            .Value = NextRow.Row - 1
'apply required number format
            .NumberFormat = "0000"
        End With


    End With
End Sub

I have assumed Row 1 is a header row but adjust as required.

Dave

 

[NoSparks]

Another way would be using a real table instead of a standard range and using max + 1 on the ID column.

Private Sub OutPutData()
    Dim oLo As ListObject
    Dim oNewRow As ListRow
    Dim NewID As Long

' use first table on sheet ("or specify name")
Set oLo = Worksheets("List").ListObjects(1)

' NewID
If oLo.ListRows.Count = 0 Then
    NewID = 1
Else
    NewID = Application.Max(oLo.ListColumns(1).DataBodyRange) + 1
End If

' insert table row and data
Set oNewRow = oLo.ListRows.Add(AlwaysInsert:=True)
    With oNewRow
        .Range.Cells(1) = NewID
        .Range.Cells(2) = TextBox_PI_Case
        .Range.Cells(3) = TextBox_Company_Name
        .Range.Cells(4) = "NEW"
        .Range.Cells(5) = TextBox_RoR
        .Range.Cells(6) = TextBox_Comments
        .Range.Cells(7) = Date
    End With
End Sub

You may also find use of a table would simplify the solution to your previous question, especially now that the ID will be added at the same time as the rest of the data.

Here's a couple of links to sites dealing with tables.
https://www.thespreadsheetguru.com/blog/2014/6/20/the-vba-guide-to-listobject-excel-tables
http://www.jkp-ads.com/Articles/Excel2007TablesVBA.asp?AllComments=True

 

[VanillaSky]

Another way would be using a real table
You may also find use of a table would simplify the solution to your previous question, especially now that the ID will be added at the same time as the rest of the data.

Well, I made it work somehow without using a table, however after that I realised that I will need table for filtering anyway, so thank you for your suggestions! I will surely make use of them

 

[VanillaSky]

If anyone looks for solution for similar problem, here is one that worked for me:

Private Function GetNewID(Cel As Range) As Long 'Or As String. Depends on requirements
    Dim Tmp 
    Tmp = Cel.Offset(-1, -1).Value2 
    
    If UCase(Tmp) = "ID" Then 
        GetNewID = 1 
    ElseIf IsNumeric(Tmp) Then 
        GetNewID = CLng(Tmp) + 1 
    End If
End Function

Private Sub OutPutData() 
    Dim NextRow As Range 
    
    Set NextRow = Worksheets("List").Cells(Rows.Count, "B").End(xlUp).Offset(1).Resize(1, 6) 
    With Me 
        NextRow.Cells(1).Offset(, -1) = GetNewID(NextRow.Cells(1)) 
        NextRow.Cells(1) = .TextBox_PI_Case 
        NextRow.Cells(2) = .TextBox_Company_Name 
        NextRow.Cells(3) = "NEW" 
        NextRow.Cells(4) = .TextBox_RoR 
        NextRow.Cells(5) = .TextBox_Comments 
        NextRow.Cells(6) = Date 
        
    End With
End Sub

Hope it helps!