Hi all,
When a record entry is aborted (pressing Esc), the Group_Count still stores the next increment number in the Group_Counts table. This is basically creating the same problem as using auto number where it misses out the next number after cancelling an entry.
Is there something I need to write into the code to prevent this from happening? I'm not an expert with using code by any means, I stumbled across this useful module when searching online for examples and have adapted it to suit what I need.
Could someone please possibly help and explain what I need to do to fix this issue? (Bearing in mind I'm a complete rookie at this stuff!!)
Many thanks
Option Compare Database
Option Explicit
Code:
Function NewPart_Number(pGroup_ID) As String
Dim db As Database
Dim LSQL As String
Dim LUpdate As String
Dim LInsert As String
Dim Lrs As DAO.Recordset
Dim LNewPart_Number As String
On Error GoTo Err_Execute
Set db = CurrentDb()
'Retrieve last number assigned for Group Type
LSQL = "Select Group_Count from tbl_Group_Counts"
LSQL = LSQL & " where Group_Prefix = '" & pGroup_ID & "'"
Set Lrs = db.OpenRecordset(LSQL)
'If no records were found, create a new Group Type in the Group_Counts table
'and set initial value to 1
If Lrs.EOF = True Then
LInsert = "Insert into tbl_Group_Counts (Group_Prefix, Group_Count)"
LInsert = LInsert & " values "
LInsert = LInsert & "('" & pGroup_ID & "', 1)"
db.Execute LInsert, dbFailOnError
'New Part_Number is formatted as "SP-0001", for example
LNewPart_Number = pGroup_ID & "-" & Format(1, "0000")
Else
'Determine new Part_Number
'New Part_Number is formatted as "SP-0001", for example
LNewPart_Number = pGroup_ID & "-" & Format(Lrs("Group_Count") + 1, "0000")
'Increment counter in Group_Counts table by 1
LUpdate = "Update tbl_Group_Counts"
LUpdate = LUpdate & " set Group_Count = " & Lrs("Group_Count") + 1
LUpdate = LUpdate & " where Group_Prefix = '" & pGroup_ID & "'"
db.Execute LUpdate, dbFailOnError
End If
Lrs.Close
Set Lrs = Nothing
Set db = Nothing
NewPart_Number = LNewPart_Number
Exit Function
Err_Execute:
'An error occurred, return blank string
NewPart_Number = ""
MsgBox "An error occurred while trying to determine the next Part_Number to assign."
End Function