Help with auto numbers in Access

  • Thread starter Thread starter Guest
  • Start date Start date
G

Guest

I need to do an auto number using the last 2 digits of the year and than an
autonumber. Ex. 05-0001. PLEASE HELP!!!!
 
I answered a similar post for Shane a day or two ago. Here is the post
(similar but different):

Shane, this function will get you on the right track. The function checks
table1 for the max value in the field [What]. This value is incremented by
one, formatted, and returned . You would also need to add some error
handling and another function to insert the data into the desired table :

Function fSetID() As String

Dim strYear As String
Dim strMonth As String
Dim strCode As String
Dim strMaxID As String
Dim strNewID As String

strYear = CStr(Format(Year(Date), "YY"))
strMonth = CStr(Format(Month(Date), "MM"))

strMaxID = DMax("[What]", "Table1", "[What] Is Not Null")

strCode = Format(Right(strMaxID, 3) + 1, "000")
strNewID = strMonth & strYear & "-" & strCode

Debug.Print strNewID

fSetID = strNewID

End Function
 
Try this code. Watch for line wrapping:

Function DateNum() As String
'********************************************************************
' Name: DateNum
' Purpose: Generate an incremental "number" based on the year
'
' Author: Arvin Meyer
' Date: July 27, 2003
' Comment: Assumes Table1 As Table and CaseNum As Field
' Generates in the format of 03-0001, 03-0002, etc.
' Seed the first number if other than 0000
'********************************************************************
On Error GoTo Error_Handler

Dim intNumber As Integer
Dim db As DAO.Database
Dim rs As DAO.Recordset

Set db = CurrentDb
Set rs = db.OpenRecordset("Select [CaseNum] from [Table1] order by
[CaseNum];")

If Not rs.EOF Then
rs.MoveLast
If Left(rs.Fields("CaseNum"), 4) = CStr(Year(Date)) Then
intNumber = Val(Mid(rs.Fields("CaseNum"), 3)) + 1
Else
intNumber = 1
End If
End If

DateNum = Format(Year(Date),"yy") & "-" & Format(intNumber, "0000")

With rs
.AddNew
!CaseNum = DateNum
.Update
End With

Exit_Here:
rs.Close
Set rs = Nothing
Set db = Nothing
Exit Function

Error_Handler: 'If someone is editing this record trap the error
Dim intRetry As Integer
If Err = 3188 Then
intRetry = intRetry + 1
If intRetry < 100 Then
Resume
Else 'Time out retries
MsgBox Err.Number, vbOKOnly, "Another user editing this number"
Resume Exit_Here
End If
Else 'Handle other errors
MsgBox Err.Number & ": " & Err.Description, vbOKOnly, "Problem
Generating Number"
Resume Exit_Here
End If

End Function
--
Arvin Meyer, MCP, MVP
Microsoft Access
Free Access downloads
http://www.datastrat.com
http://www.mvps.org/access
 
I just got an email from someone concerning a bug in code I posted in this
forum last November under the subject of "Help with auto numbers in Access"
I found another bug in addition so I wanted to correct the code. The code
creates an
autonumber based on the date in the format: 06-0001 ... 99-9999

If you have a requirement for more than 10,000 or to last longer than the
year 2099, make alterations to allow for those contingencies:

Function DateNum() As String
'********************************************************************
' Name: DateNum
' Purpose: Generate an incremental "number" based on the year
'
' Author: Arvin Meyer
' Date: July 27, 2003, Revised February/25/2006
' Comment: Assumes Table1 As Table and CaseNum As Field
' Generates in the format of 03-0001, 03-0002, etc.
' Seed the first number if other than 0000
'********************************************************************
On Error GoTo Error_Handler

Dim intNumber As Integer
Dim db As DAO.Database
Dim rs As DAO.Recordset

Set db = CurrentDb
Set rs = db.OpenRecordset("Select [CaseNum] from [Table1] order by
[CaseNum];")

If Not rs.EOF Then
rs.MoveLast
If Left(rs.Fields("CaseNum"), 2) = CStr(Right(year(Date), 2)) Then
intNumber = Val(Mid(rs.Fields("CaseNum"), 4)) + 1
Else
intNumber = 1
End If
End If

DateNum = Right(year(Date), 2) & "-" & Format(intNumber, "0000")

With rs
.AddNew
!CaseNum = DateNum
.Update
End With

Exit_Here:
rs.Close
Set rs = Nothing
Set db = Nothing
Exit Function

Error_Handler: 'If someone is editing this record trap the error
Dim intRetry As Integer
If Err = 3188 Then
intRetry = intRetry + 1
If intRetry < 100 Then
Resume
Else 'Time out retries
MsgBox Err.Number, vbOKOnly, "Another user editing this number"
Resume Exit_Here
End If
Else 'Handle other errors
MsgBox Err.Number & ": " & Err.Description, vbOKOnly, "Problem
Generating Number"
Resume Exit_Here
End If

End Function

--
Arvin Meyer, MCP, MVP
Microsoft Access
Free Access downloads
http://www.datastrat.com
http://www.mvps.org/access


Arvin Meyer said:
Try this code. Watch for line wrapping:

Function DateNum() As String
'********************************************************************
' Name: DateNum
' Purpose: Generate an incremental "number" based on the year
'
' Author: Arvin Meyer
' Date: July 27, 2003
' Comment: Assumes Table1 As Table and CaseNum As Field
' Generates in the format of 03-0001, 03-0002, etc.
' Seed the first number if other than 0000
'********************************************************************
On Error GoTo Error_Handler

Dim intNumber As Integer
Dim db As DAO.Database
Dim rs As DAO.Recordset

Set db = CurrentDb
Set rs = db.OpenRecordset("Select [CaseNum] from [Table1] order by
[CaseNum];")

If Not rs.EOF Then
rs.MoveLast
If Left(rs.Fields("CaseNum"), 4) = CStr(Year(Date)) Then
intNumber = Val(Mid(rs.Fields("CaseNum"), 3)) + 1
Else
intNumber = 1
End If
End If

DateNum = Format(Year(Date),"yy") & "-" & Format(intNumber, "0000")

With rs
.AddNew
!CaseNum = DateNum
.Update
End With

Exit_Here:
rs.Close
Set rs = Nothing
Set db = Nothing
Exit Function

Error_Handler: 'If someone is editing this record trap the error
Dim intRetry As Integer
If Err = 3188 Then
intRetry = intRetry + 1
If intRetry < 100 Then
Resume
Else 'Time out retries
MsgBox Err.Number, vbOKOnly, "Another user editing this number"
Resume Exit_Here
End If
Else 'Handle other errors
MsgBox Err.Number & ": " & Err.Description, vbOKOnly, "Problem
Generating Number"
Resume Exit_Here
End If

End Function
--
Arvin Meyer, MCP, MVP
Microsoft Access
Free Access downloads
http://www.datastrat.com
http://www.mvps.org/access


Renee said:
I need to do an auto number using the last 2 digits of the year and than an
autonumber. Ex. 05-0001. PLEASE HELP!!!!
Click to expand...
Click to expand...
 
I just got an email from someone concerning a bug in code I posted in this
forum last November under the subject of "Help with auto numbers in Access"
I found another bug in addition so I wanted to correct the code. The code
creates an
autonumber based on the date in the format: 06-0001 ... 99-9999

If you have a requirement for more than 10,000 or to last longer than the
year 2099, make alterations to allow for those contingencies:

Function DateNum() As String
'********************************************************************
' Name: DateNum
' Purpose: Generate an incremental "number" based on the year
'
' Author: Arvin Meyer
' Date: July 27, 2003, Revised February/25/2006
' Comment: Assumes Table1 As Table and CaseNum As Field
' Generates in the format of 03-0001, 03-0002, etc.
' Seed the first number if other than 0000
'********************************************************************
On Error GoTo Error_Handler

Dim intNumber As Integer
Dim db As DAO.Database
Dim rs As DAO.Recordset

Set db = CurrentDb
Set rs = db.OpenRecordset("Select [CaseNum] from [Table1] order by
[CaseNum];")

If Not rs.EOF Then
rs.MoveLast
If Left(rs.Fields("CaseNum"), 2) = CStr(Right(year(Date), 2)) Then
intNumber = Val(Mid(rs.Fields("CaseNum"), 4)) + 1
Else
intNumber = 1
End If
End If

DateNum = Right(year(Date), 2) & "-" & Format(intNumber, "0000")

With rs
.AddNew
!CaseNum = DateNum
.Update
End With

Exit_Here:
rs.Close
Set rs = Nothing
Set db = Nothing
Exit Function

Error_Handler: 'If someone is editing this record trap the error
Dim intRetry As Integer
If Err = 3188 Then
intRetry = intRetry + 1
If intRetry < 100 Then
Resume
Else 'Time out retries
MsgBox Err.Number, vbOKOnly, "Another user editing this number"
Resume Exit_Here
End If
Else 'Handle other errors
MsgBox Err.Number & ": " & Err.Description, vbOKOnly, "Problem
Generating Number"
Resume Exit_Here
End If

End Function

--
Arvin Meyer, MCP, MVP
Microsoft Access
Free Access downloads
http://www.datastrat.com
http://www.mvps.org/access


Arvin Meyer said:
Try this code. Watch for line wrapping:

Function DateNum() As String
'********************************************************************
' Name: DateNum
' Purpose: Generate an incremental "number" based on the year
'
' Author: Arvin Meyer
' Date: July 27, 2003
' Comment: Assumes Table1 As Table and CaseNum As Field
' Generates in the format of 03-0001, 03-0002, etc.
' Seed the first number if other than 0000
'********************************************************************
On Error GoTo Error_Handler

Dim intNumber As Integer
Dim db As DAO.Database
Dim rs As DAO.Recordset

Set db = CurrentDb
Set rs = db.OpenRecordset("Select [CaseNum] from [Table1] order by
[CaseNum];")

If Not rs.EOF Then
rs.MoveLast
If Left(rs.Fields("CaseNum"), 4) = CStr(Year(Date)) Then
intNumber = Val(Mid(rs.Fields("CaseNum"), 3)) + 1
Else
intNumber = 1
End If
End If

DateNum = Format(Year(Date),"yy") & "-" & Format(intNumber, "0000")

With rs
.AddNew
!CaseNum = DateNum
.Update
End With

Exit_Here:
rs.Close
Set rs = Nothing
Set db = Nothing
Exit Function

Error_Handler: 'If someone is editing this record trap the error
Dim intRetry As Integer
If Err = 3188 Then
intRetry = intRetry + 1
If intRetry < 100 Then
Resume
Else 'Time out retries
MsgBox Err.Number, vbOKOnly, "Another user editing this number"
Resume Exit_Here
End If
Else 'Handle other errors
MsgBox Err.Number & ": " & Err.Description, vbOKOnly, "Problem
Generating Number"
Resume Exit_Here
End If

End Function
--
Arvin Meyer, MCP, MVP
Microsoft Access
Free Access downloads
http://www.datastrat.com
http://www.mvps.org/access


Renee said:
I need to do an auto number using the last 2 digits of the year and than an
autonumber. Ex. 05-0001. PLEASE HELP!!!!
Click to expand...
Click to expand...
Click to expand...
 
Hi,

I am trying to use this code that has been so graciously provided but due to
lack of experience I am having THE MOST frustrating time getting it to work
consistently for me. Would someone please give me a hand.

I have taken the code and placed it in a module and I call the DateNum
function using a button with click event procedure.

Private Sub CreateCntlNum_Click()
DateNum
End Sub

I want the unique id created(09-0001) and a message box to popup stating
that this number has been created. Sometimes the number is created sometime
its not but the only way I can tell it is to look on the actual
table(Request_Log) it's not showing on the form field (Control_Number). No
error message is occuring. Also it keeps creating the same number(09-0001).
Any and all assistance is greatly appreciated. Thank you.

Function DateNum() As String
'********************************************************************
' Name: DateNum
' Purpose: Generate an incremental "number" based on the year
'
' Author: Arvin Meyer
' Date: July 27, 2003, Revised February/25/2006
' Comment: Assumes Table1 As Table and CaseNum As Field
' Generates in the format of 03-0001, 03-0002, etc.
' Seed the first number if other than 0000
'********************************************************************
On Error GoTo Error_Handler

Dim intNumber As Integer
Dim db As DAO.Database
Dim rs As DAO.Recordset

Set db = CurrentDb
Set rs = db.OpenRecordset("Select [Control_Number] from [Request_Log] order
by [Control_Number];")

If Not rs.EOF Then
rs.MoveLast
If Left(rs.Fields("Control_Number"), 2) = CStr(Right(Year(Date), 2)) Then
intNumber = Val(Mid(rs.Fields("Control_Number"), 4)) + 1
Else
intNumber = 1
End If
End If

DateNum = Right(Year(Date), 2) & "-" & Format(intNumber, "0000")

With rs
.AddNew
!Control_Number = DateNum
.Update
End With

Exit_Here:
rs.Close
Set rs = Nothing
Set db = Nothing
Exit Function

Error_Handler: 'If someone is editing this record trap the error
Dim intRetry As Integer
If Err = 3188 Then
intRetry = intRetry + 1
If intRetry < 100 Then
Resume
Else 'Time out retries
MsgBox Err.Number, vbOKOnly, "Another user editing this number"
Resume Exit_Here
End If
Else 'Handle other errors
MsgBox Err.Number & ": " & Err.Description, vbOKOnly, "Problem
Generating Number"
Resume Exit_Here
End If

End Function
Function DateNum() As String
'********************************************************************
' Name: DateNum
' Purpose: Generate an incremental "number" based on the year
'
' Author: Arvin Meyer
' Date: July 27, 2003, Revised February/25/2006
' Comment: Assumes Table1 As Table and CaseNum As Field
' Generates in the format of 03-0001, 03-0002, etc.
' Seed the first number if other than 0000
'********************************************************************
On Error GoTo Error_Handler

Dim intNumber As Integer
Dim db As DAO.Database
Dim rs As DAO.Recordset

Set db = CurrentDb
Set rs = db.OpenRecordset("Select [CaseNum] from [Table1] order by
[CaseNum];")

If Not rs.EOF Then
rs.MoveLast
If Left(rs.Fields("CaseNum"), 2) = CStr(Right(year(Date), 2)) Then
intNumber = Val(Mid(rs.Fields("CaseNum"), 4)) + 1
Else
intNumber = 1
End If
End If

DateNum = Right(year(Date), 2) & "-" & Format(intNumber, "0000")

With rs
.AddNew
!CaseNum = DateNum
.Update
End With

Exit_Here:
rs.Close
Set rs = Nothing
Set db = Nothing
Exit Function

Error_Handler: 'If someone is editing this record trap the error
Dim intRetry As Integer
If Err = 3188 Then
intRetry = intRetry + 1
If intRetry < 100 Then
Resume
Else 'Time out retries
MsgBox Err.Number, vbOKOnly, "Another user editing this number"
Resume Exit_Here
End If
Else 'Handle other errors
MsgBox Err.Number & ": " & Err.Description, vbOKOnly, "Problem
Generating Number"
Resume Exit_Here
End If

End Function

--
Arvin Meyer, MCP, MVP
Microsoft Access
Free Access downloads
http://www.datastrat.com
http://www.mvps.org/access


Arvin Meyer said:
Try this code. Watch for line wrapping:

Function DateNum() As String
'********************************************************************
' Name: DateNum
' Purpose: Generate an incremental "number" based on the year
'
' Author: Arvin Meyer
' Date: July 27, 2003
' Comment: Assumes Table1 As Table and CaseNum As Field
' Generates in the format of 03-0001, 03-0002, etc.
' Seed the first number if other than 0000
'********************************************************************
On Error GoTo Error_Handler

Dim intNumber As Integer
Dim db As DAO.Database
Dim rs As DAO.Recordset

Set db = CurrentDb
Set rs = db.OpenRecordset("Select [CaseNum] from [Table1] order by
[CaseNum];")

If Not rs.EOF Then
rs.MoveLast
If Left(rs.Fields("CaseNum"), 4) = CStr(Year(Date)) Then
intNumber = Val(Mid(rs.Fields("CaseNum"), 3)) + 1
Else
intNumber = 1
End If
End If

DateNum = Format(Year(Date),"yy") & "-" & Format(intNumber, "0000")

With rs
.AddNew
!CaseNum = DateNum
.Update
End With

Exit_Here:
rs.Close
Set rs = Nothing
Set db = Nothing
Exit Function

Error_Handler: 'If someone is editing this record trap the error
Dim intRetry As Integer
If Err = 3188 Then
intRetry = intRetry + 1
If intRetry < 100 Then
Resume
Else 'Time out retries
MsgBox Err.Number, vbOKOnly, "Another user editing this number"
Resume Exit_Here
End If
Else 'Handle other errors
MsgBox Err.Number & ": " & Err.Description, vbOKOnly, "Problem
Generating Number"
Resume Exit_Here
End If

End Function
--
Arvin Meyer, MCP, MVP
Microsoft Access
Free Access downloads
http://www.datastrat.com
http://www.mvps.org/access
Click to expand...
Click to expand...
 
I just tested using your fields and it works fine. I see 2 possible
problems.

1. Instead of

Private Sub CreateCntlNum_Click()
DateNum
End Sub

You need to place the number in the form's textbox:

Private Sub CreateCntlNum_Click()
txtControl_Number = DateNum ()
End Sub

2. You may have the wrong seed in the table. The seed should be:

09-0000 or 09-0001

for the first record.
--
Arvin Meyer, MCP, MVP
http://www.datastrat.com
http://www.mvps.org/access
http://www.accessmvp.com


MyMel said:
Hi,

I am trying to use this code that has been so graciously provided but due
to
lack of experience I am having THE MOST frustrating time getting it to
work
consistently for me. Would someone please give me a hand.

I have taken the code and placed it in a module and I call the DateNum
function using a button with click event procedure.

Private Sub CreateCntlNum_Click()
DateNum
End Sub

I want the unique id created(09-0001) and a message box to popup stating
that this number has been created. Sometimes the number is created
sometime
its not but the only way I can tell it is to look on the actual
table(Request_Log) it's not showing on the form field (Control_Number).
No
error message is occuring. Also it keeps creating the same
number(09-0001).
Any and all assistance is greatly appreciated. Thank you.

Function DateNum() As String
'********************************************************************
' Name: DateNum
' Purpose: Generate an incremental "number" based on the year
'
' Author: Arvin Meyer
' Date: July 27, 2003, Revised February/25/2006
' Comment: Assumes Table1 As Table and CaseNum As Field
' Generates in the format of 03-0001, 03-0002, etc.
' Seed the first number if other than 0000
'********************************************************************
On Error GoTo Error_Handler

Dim intNumber As Integer
Dim db As DAO.Database
Dim rs As DAO.Recordset

Set db = CurrentDb
Set rs = db.OpenRecordset("Select [Control_Number] from [Request_Log]
order
by [Control_Number];")

If Not rs.EOF Then
rs.MoveLast
If Left(rs.Fields("Control_Number"), 2) = CStr(Right(Year(Date), 2))
Then
intNumber = Val(Mid(rs.Fields("Control_Number"), 4)) + 1
Else
intNumber = 1
End If
End If

DateNum = Right(Year(Date), 2) & "-" & Format(intNumber, "0000")

With rs
.AddNew
!Control_Number = DateNum
.Update
End With

Exit_Here:
rs.Close
Set rs = Nothing
Set db = Nothing
Exit Function

Error_Handler: 'If someone is editing this record trap the error
Dim intRetry As Integer
If Err = 3188 Then
intRetry = intRetry + 1
If intRetry < 100 Then
Resume
Else 'Time out retries
MsgBox Err.Number, vbOKOnly, "Another user editing this number"
Resume Exit_Here
End If
Else 'Handle other errors
MsgBox Err.Number & ": " & Err.Description, vbOKOnly, "Problem
Generating Number"
Resume Exit_Here
End If

End Function
Function DateNum() As String
'********************************************************************
' Name: DateNum
' Purpose: Generate an incremental "number" based on the year
'
' Author: Arvin Meyer
' Date: July 27, 2003, Revised February/25/2006
' Comment: Assumes Table1 As Table and CaseNum As Field
' Generates in the format of 03-0001, 03-0002, etc.
' Seed the first number if other than 0000
'********************************************************************
On Error GoTo Error_Handler

Dim intNumber As Integer
Dim db As DAO.Database
Dim rs As DAO.Recordset

Set db = CurrentDb
Set rs = db.OpenRecordset("Select [CaseNum] from [Table1] order by
[CaseNum];")

If Not rs.EOF Then
rs.MoveLast
If Left(rs.Fields("CaseNum"), 2) = CStr(Right(year(Date), 2)) Then
intNumber = Val(Mid(rs.Fields("CaseNum"), 4)) + 1
Else
intNumber = 1
End If
End If

DateNum = Right(year(Date), 2) & "-" & Format(intNumber, "0000")

With rs
.AddNew
!CaseNum = DateNum
.Update
End With

Exit_Here:
rs.Close
Set rs = Nothing
Set db = Nothing
Exit Function

Error_Handler: 'If someone is editing this record trap the error
Dim intRetry As Integer
If Err = 3188 Then
intRetry = intRetry + 1
If intRetry < 100 Then
Resume
Else 'Time out retries
MsgBox Err.Number, vbOKOnly, "Another user editing this
number"
Resume Exit_Here
End If
Else 'Handle other errors
MsgBox Err.Number & ": " & Err.Description, vbOKOnly, "Problem
Generating Number"
Resume Exit_Here
End If

End Function

--
Arvin Meyer, MCP, MVP
Microsoft Access
Free Access downloads
http://www.datastrat.com
http://www.mvps.org/access


Arvin Meyer said:
Try this code. Watch for line wrapping:

Function DateNum() As String
'********************************************************************
' Name: DateNum
' Purpose: Generate an incremental "number" based on the year
'
' Author: Arvin Meyer
' Date: July 27, 2003
' Comment: Assumes Table1 As Table and CaseNum As Field
' Generates in the format of 03-0001, 03-0002, etc.
' Seed the first number if other than 0000
'********************************************************************
On Error GoTo Error_Handler

Dim intNumber As Integer
Dim db As DAO.Database
Dim rs As DAO.Recordset

Set db = CurrentDb
Set rs = db.OpenRecordset("Select [CaseNum] from [Table1] order by
[CaseNum];")

If Not rs.EOF Then
rs.MoveLast
If Left(rs.Fields("CaseNum"), 4) = CStr(Year(Date)) Then
intNumber = Val(Mid(rs.Fields("CaseNum"), 3)) + 1
Else
intNumber = 1
End If
End If

DateNum = Format(Year(Date),"yy") & "-" & Format(intNumber, "0000")

With rs
.AddNew
!CaseNum = DateNum
.Update
End With

Exit_Here:
rs.Close
Set rs = Nothing
Set db = Nothing
Exit Function

Error_Handler: 'If someone is editing this record trap the error
Dim intRetry As Integer
If Err = 3188 Then
intRetry = intRetry + 1
If intRetry < 100 Then
Resume
Else 'Time out retries
MsgBox Err.Number, vbOKOnly, "Another user editing this
number"
Resume Exit_Here
End If
Else 'Handle other errors
MsgBox Err.Number & ": " & Err.Description, vbOKOnly,
"Problem
Generating Number"
Resume Exit_Here
End If

End Function
--
Arvin Meyer, MCP, MVP
Microsoft Access
Free Access downloads
http://www.datastrat.com
http://www.mvps.org/access
Click to expand...
Click to expand...
Click to expand...
 
Thank you, it works great now.

Arvin Meyer said:
I just tested using your fields and it works fine. I see 2 possible
problems.

1. Instead of

Private Sub CreateCntlNum_Click()
DateNum
End Sub

You need to place the number in the form's textbox:

Private Sub CreateCntlNum_Click()
txtControl_Number = DateNum ()
End Sub

2. You may have the wrong seed in the table. The seed should be:

09-0000 or 09-0001

for the first record.
--
Arvin Meyer, MCP, MVP
http://www.datastrat.com
http://www.mvps.org/access
http://www.accessmvp.com


MyMel said:
Hi,

I am trying to use this code that has been so graciously provided but due
to
lack of experience I am having THE MOST frustrating time getting it to
work
consistently for me. Would someone please give me a hand.

I have taken the code and placed it in a module and I call the DateNum
function using a button with click event procedure.

Private Sub CreateCntlNum_Click()
DateNum
End Sub

I want the unique id created(09-0001) and a message box to popup stating
that this number has been created. Sometimes the number is created
sometime
its not but the only way I can tell it is to look on the actual
table(Request_Log) it's not showing on the form field (Control_Number).
No
error message is occuring. Also it keeps creating the same
number(09-0001).
Any and all assistance is greatly appreciated. Thank you.

Function DateNum() As String
'********************************************************************
' Name: DateNum
' Purpose: Generate an incremental "number" based on the year
'
' Author: Arvin Meyer
' Date: July 27, 2003, Revised February/25/2006
' Comment: Assumes Table1 As Table and CaseNum As Field
' Generates in the format of 03-0001, 03-0002, etc.
' Seed the first number if other than 0000
'********************************************************************
On Error GoTo Error_Handler

Dim intNumber As Integer
Dim db As DAO.Database
Dim rs As DAO.Recordset

Set db = CurrentDb
Set rs = db.OpenRecordset("Select [Control_Number] from [Request_Log]
order
by [Control_Number];")

If Not rs.EOF Then
rs.MoveLast
If Left(rs.Fields("Control_Number"), 2) = CStr(Right(Year(Date), 2))
Then
intNumber = Val(Mid(rs.Fields("Control_Number"), 4)) + 1
Else
intNumber = 1
End If
End If

DateNum = Right(Year(Date), 2) & "-" & Format(intNumber, "0000")

With rs
.AddNew
!Control_Number = DateNum
.Update
End With

Exit_Here:
rs.Close
Set rs = Nothing
Set db = Nothing
Exit Function

Error_Handler: 'If someone is editing this record trap the error
Dim intRetry As Integer
If Err = 3188 Then
intRetry = intRetry + 1
If intRetry < 100 Then
Resume
Else 'Time out retries
MsgBox Err.Number, vbOKOnly, "Another user editing this number"
Resume Exit_Here
End If
Else 'Handle other errors
MsgBox Err.Number & ": " & Err.Description, vbOKOnly, "Problem
Generating Number"
Resume Exit_Here
End If

End Function
Function DateNum() As String
'********************************************************************
' Name: DateNum
' Purpose: Generate an incremental "number" based on the year
'
' Author: Arvin Meyer
' Date: July 27, 2003, Revised February/25/2006
' Comment: Assumes Table1 As Table and CaseNum As Field
' Generates in the format of 03-0001, 03-0002, etc.
' Seed the first number if other than 0000
'********************************************************************
On Error GoTo Error_Handler

Dim intNumber As Integer
Dim db As DAO.Database
Dim rs As DAO.Recordset

Set db = CurrentDb
Set rs = db.OpenRecordset("Select [CaseNum] from [Table1] order by
[CaseNum];")

If Not rs.EOF Then
rs.MoveLast
If Left(rs.Fields("CaseNum"), 2) = CStr(Right(year(Date), 2)) Then
intNumber = Val(Mid(rs.Fields("CaseNum"), 4)) + 1
Else
intNumber = 1
End If
End If

DateNum = Right(year(Date), 2) & "-" & Format(intNumber, "0000")

With rs
.AddNew
!CaseNum = DateNum
.Update
End With

Exit_Here:
rs.Close
Set rs = Nothing
Set db = Nothing
Exit Function

Error_Handler: 'If someone is editing this record trap the error
Dim intRetry As Integer
If Err = 3188 Then
intRetry = intRetry + 1
If intRetry < 100 Then
Resume
Else 'Time out retries
MsgBox Err.Number, vbOKOnly, "Another user editing this
number"
Resume Exit_Here
End If
Else 'Handle other errors
MsgBox Err.Number & ": " & Err.Description, vbOKOnly, "Problem
Generating Number"
Resume Exit_Here
End If

End Function

--
Arvin Meyer, MCP, MVP
Microsoft Access
Free Access downloads
http://www.datastrat.com
http://www.mvps.org/access


:

Try this code. Watch for line wrapping:

Function DateNum() As String
'********************************************************************
' Name: DateNum
' Purpose: Generate an incremental "number" based on the year
'
' Author: Arvin Meyer
' Date: July 27, 2003
' Comment: Assumes Table1 As Table and CaseNum As Field
' Generates in the format of 03-0001, 03-0002, etc.
' Seed the first number if other than 0000
'********************************************************************
On Error GoTo Error_Handler

Dim intNumber As Integer
Dim db As DAO.Database
Dim rs As DAO.Recordset

Set db = CurrentDb
Set rs = db.OpenRecordset("Select [CaseNum] from [Table1] order by
[CaseNum];")

If Not rs.EOF Then
rs.MoveLast
If Left(rs.Fields("CaseNum"), 4) = CStr(Year(Date)) Then
intNumber = Val(Mid(rs.Fields("CaseNum"), 3)) + 1
Else
intNumber = 1
End If
End If

DateNum = Format(Year(Date),"yy") & "-" & Format(intNumber, "0000")

With rs
.AddNew
!CaseNum = DateNum
.Update
End With

Exit_Here:
rs.Close
Set rs = Nothing
Set db = Nothing
Exit Function

Error_Handler: 'If someone is editing this record trap the error
Dim intRetry As Integer
If Err = 3188 Then
intRetry = intRetry + 1
If intRetry < 100 Then
Resume
Else 'Time out retries
MsgBox Err.Number, vbOKOnly, "Another user editing this
number"
Resume Exit_Here
End If
Else 'Handle other errors
MsgBox Err.Number & ": " & Err.Description, vbOKOnly,
"Problem
Generating Number"
Resume Exit_Here
End If

End Function
--
Arvin Meyer, MCP, MVP
Microsoft Access
Free Access downloads
http://www.datastrat.com
http://www.mvps.org/access
Click to expand...
Click to expand...


.
Click to expand...
 
Back
Top