Generate/Assign Unique ID to each new record added by a Userform

Melimob

Active Member
Joined
Oct 16, 2011
Messages
395
Office Version
  1. 365
Hi all - ok last question for today please...

I already have a userform but I would like to add a unique reference to each new record added and this to stay attached to that record (i.e. not reused if the data is resorted / row deleted etc..).

so far this is my code to enter textbox data to last row in datasheet:

I know it's not the prettiest but am (trying) to learn all this - very new to it..

Code:
Private Sub cmdTransferVal_Click()


    
    Dim lrVal As Long, lrList As Long, lrSales As Long, lrExc As Long


       
lrVal = Sheets("Valuations").Range("B" & Rows.Count).End(xlUp).Row
Sheets("Valuations").Cells(lrVal + 1, "B").Value = cbxOfficeVal.Text
Sheets("Valuations").Cells(lrVal + 1, "C").Value = tbDateVal.Text
Sheets("Valuations").Cells(lrVal + 1, "D").Value = cbxValuer.Text
Sheets("Valuations").Cells(lrVal + 1, "E").Value = tbHouseVal.Text
Sheets("Valuations").Cells(lrVal + 1, "F").Value = tbStreetVal.Text
Sheets("Valuations").Cells(lrVal + 1, "G").Value = tbCityVal.Text
Sheets("Valuations").Cells(lrVal + 1, "H").Value = tbPostCodeVal.Text
Sheets("Valuations").Cells(lrVal + 1, "I").Value = tbVendorVal.Text
Sheets("Valuations").Cells(lrVal + 1, "J").Value = tbValueAmountVal.Text
    If chbValLetter.Value = True Then
        Sheets("Valuations").Cells(lrVal + 1, "K").Value = "Y"
    Else
        Sheets("Valuations").Cells(lrVal + 1, "K").Value = "N"
          
End If


Sheets("Valuations").Cells(lrVal + 1, "L").Value = cbxEnqSourceVal.Text
Sheets("Valuations").Cells(lrVal + 1, "M").Value = cbxDataSourceVal.Text
Sheets("Valuations").Cells(lrVal + 1, "N").Value = tbNotesVal.Text


End Sub

I could use column A for the unique record. I thought of labelling what I have so far as RM1(drag down to last so shows RM2, RM3 etc...) then use =INDEX(A:A,MATCH(REPT("z",255),A:A)) to return the last RM number then tie VBA code to read this cell +1 to add to next cell but not sure if this is the best way (and have also got stuck on how I would adapt the above code to incorporate this?).

Any advice most appreciated! thank you all!
 

Excel Facts

Test for Multiple Conditions in IF?
Use AND(test, test, test, test) or OR(test, test, test, ...) as the logical_test argument of IF.
Hi,
have a look at this thread:http://www.mrexcel.com/forum/excel-...ic-applications-auto-generate-unique-ids.html

Rick's suggestion (post#3) is nice & simple but other posts may be of help to you.

Also, hope don't mind suggestion to consider using With Statements in your code to reduce the need to repeat the use of the worksheet object - something like this:

Code:
Private Sub cmdTransferVal_Click()






    Dim lrVal As Long, lrList As Long, lrSales As Long, lrExc As Long




    With Sheets("Valuations")
        lrVal = .Range("B" & .Rows.Count).End(xlUp).Row + 1
        .Cells(lrVal, "B").Value = cbxOfficeVal.Text
        .Cells(lrVal, "C").Value = tbDateVal.Text
        .Cells(lrVal, "D").Value = cbxValuer.Text
        .Cells(lrVal, "E").Value = tbHouseVal.Text
        .Cells(lrVal, "F").Value = tbStreetVal.Text
        .Cells(lrVal, "G").Value = tbCityVal.Text
        .Cells(lrVal, "H").Value = tbPostCodeVal.Text
        .Cells(lrVal, "I").Value = tbVendorVal.Text
        .Cells(lrVal, "J").Value = tbValueAmountVal.Text


        .Cells(lrVal, "K").Value = IIf(chbValLetter.Value, "Y", "N")


        .Cells(lrVal, "L").Value = cbxEnqSourceVal.Text
        .Cells(lrVal, "M").Value = cbxDataSourceVal.Text
        .Cells(lrVal, "N").Value = tbNotesVal.Text
    End With


End Sub

There are other ways to do this but thought might find this approach useful.

Hope helpful

Dave
 
Upvote 0
Hi,
have a look at this thread:http://www.mrexcel.com/forum/excel-...ic-applications-auto-generate-unique-ids.html

Rick's suggestion (post#3) is nice & simple but other posts may be of help to you.

Also, hope don't mind suggestion to consider using With Statements in your code to reduce the need to repeat the use of the worksheet object - something like this:

Code:
Private Sub cmdTransferVal_Click()






    Dim lrVal As Long, lrList As Long, lrSales As Long, lrExc As Long




    With Sheets("Valuations")
        lrVal = .Range("B" & .Rows.Count).End(xlUp).Row + 1
        .Cells(lrVal, "B").Value = cbxOfficeVal.Text
        .Cells(lrVal, "C").Value = tbDateVal.Text
        .Cells(lrVal, "D").Value = cbxValuer.Text
        .Cells(lrVal, "E").Value = tbHouseVal.Text
        .Cells(lrVal, "F").Value = tbStreetVal.Text
        .Cells(lrVal, "G").Value = tbCityVal.Text
        .Cells(lrVal, "H").Value = tbPostCodeVal.Text
        .Cells(lrVal, "I").Value = tbVendorVal.Text
        .Cells(lrVal, "J").Value = tbValueAmountVal.Text


        .Cells(lrVal, "K").Value = IIf(chbValLetter.Value, "Y", "N")


        .Cells(lrVal, "L").Value = cbxEnqSourceVal.Text
        .Cells(lrVal, "M").Value = cbxDataSourceVal.Text
        .Cells(lrVal, "N").Value = tbNotesVal.Text
    End With


End Sub

There are other ways to do this but thought might find this approach useful.

Hope helpful

Dave

Hi Dave

I'm MORE than happy for you to suggest things like this to me so thank you for your time to show me!

btw: I just found this piece of code which should work well for my needs, it has a few bugs if you add multiple entries at a time however for my purpose it will be using a data entry form which only allows one record at a time so is going to work for me (I hope):

Code:
Private Sub Worksheet_Change(ByVal Target As Range)If Target.Column = 2 Then 'This is the column that causes the ID to be created'This uses the target offset so it assumes in two spots below that the column to update is "A" and'that the column is one position to the left of the target column above    If Target.Offset(0, -1).Value = "" Then       Target.Offset(0, -1).Value = Application.WorksheetFunction.Max(Columns("A")) + 1    End IfEnd IfEnd SubFunction Max_Each_Column(Data_Range As Range) As Integer    Dim TempArray() As Double, i As Long        If Data_Range Is Nothing Then Exit Function        With Data_Range        ReDim TempArray(1 To .Columns.Count)        For i = 1 To .Columns.Count            TempArray(i) = Application.Max(.Columns(i))        Next    End With        Max_Each_Column = TempArrayEnd Function</pre>

this is thanks to: YouTube

Adding an ID field to an excel worksheet | lylt.org

thanks again!
 
Upvote 0
Actaually Dave, would you know how I can adapt this to include the letters 'RM' +1? the code works well for just numbers but I want to include the letter's infront and then have it increment?

code again is:
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 2 Then 'This is the column that causes the ID to be created
'This uses the target offset so it assumes in two spots below that the column to update is "A" and
'that the column is one position to the left of the target column above
    If Target.Offset(0, -1).Value = "" Then
       Target.Offset(0, -1).Value = Application.WorksheetFunction.Max(Columns("A")) + 1
    End If
End If


End Sub




Function Max_Each_Column(Data_Range As Range) As Integer
    Dim TempArray() As Double, i As Long
        If Data_Range Is Nothing Then Exit Function
        With Data_Range
        ReDim TempArray(1 To .Columns.Count)
        For i = 1 To .Columns.Count
            TempArray(i) = Application.Max(.Columns(i))
        Next
    End With
        Max_Each_Column = TempArray
End Function

many thanks
 
Upvote 0
Use a Custom NumberFormat - "RM"000. This will display numbers as RM001, etc, allowing Max to still be used. Apply the NumberFormat to the whole required column.
 
Upvote 0
Use a Custom NumberFormat - "RM"000. This will display numbers as RM001, etc, allowing Max to still be used. Apply the NumberFormat to the whole required column.

Perfect! thanks so much! :)
 
Upvote 0

Forum statistics

Threads
1,213,534
Messages
6,114,185
Members
448,554
Latest member
Gleisner2

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top