Create unique 'number'

[Anthony]

Hi all,

I have a userform that when loaded I would like it to show a unique
reference number and display it in next available cell in column A of 'data'
sheet
That number should be made up from today’s date in format ddmmyy plus a
rolling number starting from 1.
for example if the user displays the userform for the first time today the
unique number would be 05080801, they open the form again and this time it
would be 05080802, and again 05080803.

However when they open the userform tomorrow for the first time the
reference number would be 06080801

any help greatly appreciated with this as I have no idea

 

[Barb Reinhardt]

05080801 = First entry for Aug 5, 2008
05080802 = Second entry for Aug 5, 2008

I'd recommend you do it just a bit differently for sorting purposes (yymmdd##)

Alt F11, Select the ThisWorkbook module and paste
Private Sub Workbook_Open()
Call SetRefNumber
End Sub

Create a new module and paste

Option Explicit
Sub SetRefNumber()
Dim RefNumber As String
Dim myName As Name
Dim RefNumYear As Variant
Dim RefNumMo As Variant
Dim RefNumDay As Variant
Dim RefNumDate As Date
Dim RefNumCount As Variant
Dim myWS As Worksheet
Dim lRow As Long

On Error Resume Next
RefNumber = Format(Replace(ThisWorkbook.Names("RefNumber").RefersTo, "=",
""), "00000000")
On Error GoTo 0

If RefNumber <> "" Then

RefNumYear = CInt(Left(RefNumber, 2)) + 2000
RefNumMo = CInt(Mid(RefNumber, 3, 2))
RefNumDay = CInt(Mid(RefNumber, 5, 2))
RefNumCount = CInt(Mid(RefNumber, 7, 2))

RefNumDate = DateSerial(RefNumYear, RefNumMo, RefNumDay)
If RefNumDate = Date Then
RefNumCount = RefNumCount + 1
Else
RefNumDate = Date
End If

RefNumYear = Format(Year(RefNumDate) - 2000, "00")
RefNumMo = Format(Month(RefNumDate), "00")
RefNumDay = Format(Day(RefNumDate), "00")
RefNumber = RefNumYear & RefNumMo & RefNumDay & Format(RefNumCount, "00")

Else
RefNumber = Format(Year(Date) - 2000, "00") & _
Format(Month(Date), "00") & _
Format(Day(Date), "00") & "01"
End If

ThisWorkbook.Names.Add Name:="RefNumber", RefersTo:="=" & RefNumber

On Error Resume Next
Set myWS = ThisWorkbook.Worksheets("data")
On Error GoTo 0

If myWS Is Nothing Then
MsgBox ("'data' sheet doesn't exist in workbook")
Exit Sub
End If

lRow = myWS.Cells(myWS.Rows.Count, 1).End(xlUp).Row + 1
myWS.Cells(lRow, 1).Value = RefNumber

End Sub

 

[ND Pard]

Private Sub UserForm_Activate()
'This subprocedure will run every time the userform is activated

'activate the desired worksheet
Worksheets("MyWrkSht Name").Activate

'Select a cell that is in column A far, far below a possible last row
Range("A65000").Select

'Move the cursor up to the last row in column A
ActiveCell.Offset.End(xlUp).Select

'Move the cursor down 1 cell, ie, to the next blank row
ActiveCell.Offset(1).Select

'Format the cell to text
Selection.NumberFormat = "@"

'place todays date into the cell
ActiveCell.Value = Format(Now(), "mmddyy")

'if the date is equal to the date in the cell above
If Left(ActiveCell.Offset(-1), 6) = ActiveCell.Value Then

'add 1 to the end of the value in the 7 & 8 characters of the above
cell
ActiveCell.Value = ActiveCell.Value &
Format(Val(Mid(ActiveCell.Offset(-1), 7, 2)) + 1, "00")
Else

'else, add 01 to the end of today's date
ActiveCell.Value = ActiveCell.Value & "01"
End If

End Sub

 

[Anthony]

thank you, thank you, thank you, thank you
...oh by the way did I say Thanks??

Many thanks for ur help - works just great

 

[Rick Rothstein \(MVP - VB\)]

If I read your code correctly, I think you can eliminate the myName (you
didn't use this variable in your code), RefNumYear, RefNumMo, RefNumDay,
RefNumDate and RefNumCount variables by simplifying your If-Then-Else block
to this...

If Left(RefNumber, 6) = Format(Date, "yymmdd") Then
RefNumber = Format(RefNumber + 1, "00000000")
Else
RefNumber = Format(Date, "yymmdd01")
End If

I also think if you add this line...

myWS.Cells(lRow, 1).NumberFormat = "00000000"

as the next-to-the-last line of code, then the user won't have to remember
to custom format the column as "00000000".

Rick

 

[Rick Rothstein \(MVP - VB\)]

If the OP decides to use your approach, here is your complete code modified
as I suggested in my previous message...

Sub SetRefNumber()
Dim RefNumber As String
Dim myWS As Worksheet
Dim lRow As Long

On Error Resume Next
RefNumber = Format(Replace(ThisWorkbook.Names("RefNumber"). _
RefersTo, "=", ""), "00000000")
On Error GoTo 0

If Left(RefNumber, 6) = Format(Date, "yymmdd") Then
RefNumber = Format(RefNumber + 1, "00000000")
Else
RefNumber = Format(Date, "yymmdd01")
End If

ThisWorkbook.Names.Add Name:="RefNumber", RefersTo:="=" & RefNumber

On Error Resume Next
Set myWS = ThisWorkbook.Worksheets("data")
On Error GoTo 0

If myWS Is Nothing Then
MsgBox ("'data' sheet doesn't exist in workbook")
Exit Sub
End If

lRow = myWS.Cells(myWS.Rows.Count, 1).End(xlUp).Row + 1
myWS.Cells(lRow, 1).NumberFormat = "00000000"
myWS.Cells(lRow, 1).Value = RefNumber
End Sub


Rick

 

[Barb Reinhardt]

Thanks Rick. Sometimes I make things more complicated than they need to be.

Barb

 

[Rick Rothstein \(MVP - VB\)]

I think we are all guilty of that one (at least I know I am<g>).

Rick