How to create unique serial number based on todays date in format MMDDYY-XXX in VB?

[Scott Kaempfe]

I need to identify parts we buy at our plant. I want to give each a unique serial number that is based on the date. We may have multiple parts on a given date so I want to have the unique serial number in the format:
MMDDYY-XXX where XXX is a unique number that start with 001 for the first item of the day. 002 for the second, etc. but starting over the next day.

When a user enters info in the database, it may already have a number. If not, I want them to push a button and it takes today's date, serializes it based on the number of parts already existing for that date, and place that unique serial number in the PartID box for them. Then they can proceed to enter the other info.

I am learning Access 2007 and have been doing some Macros but at this point I tend to find things others have done and then learn them enough to modify them. I can figure this out eventually but I don't use Access enough to be efficient and I don't have the time.

Ideally, a VB macro done for me...at least enough to query the existing data and create the number would be great.

Does anyone already have somethign like this or can someone get me started???

Thanks!

[ADezii]

Just subscribing for now...

Are you always evaluating against the Current Date, or are you reading a Date Value from elsewhere?

[Scott Kaempfe]

Well..the way I had it set up on the form was that the form field had the date. I am currently setting the date by making it TODAY's date. So I have a macro getting the date from this field so it really shouldn't matter if it is TODAY or another date.

If for some reason it matters, I would go with TODAY's date.

Example:
1. John has a new tool that needs a unique ID number
2. It queries the database to determine if there are any tools logged into the database on this same date
3. Returns the highest unique number in MMDDYY-XXX
4. Assigns a new serial number with todays date and the next serial number.

[Scott Kaempfe]

OK - let me preface this by saying that this is a work in progress so ignore how it is formatted etc

Here is my code. The code is bold is where I am having problems. I need to either create a query that only extracts Serial Numbers with todays date OR it just looks for the last unique serial number that starts with Todays date. Not sure of the best approach.

Private Sub Command0_Click( )
Dim strCurrentYear As String
Dim strCurrentDay As String
Dim strCurrentDate As String
Dim strStaticValue As String
Dim strSequentialNo As String
Dim strLastSerialNo As String
Dim strLastSequenti alNo As String
Dim strNextSequenti alNo As String
Dim fGenerateNextSe rialNumber As String
Dim strCurrentDateT est As String

strCurrentDate = Format$(Now(), "mmddyy")

strLastSerialNo = DLookup("[SerialNo]", "tblTest", "[SerialNo] = " & strCurrentDate & "*")
'get ready to extract the Sequential Number
MsgBox strLastSerialNo
strLastSequenti alNo = Right(strLastSe rialNo, 3) 'extracts serial number

'Generate the Next Sequential Number
strNextSequenti alNo = Format(Val(strL astSequentialNo ) + 1, "000") 'produces next serial number

'Generate the next, Unique, Serial #
fGenerateNextSe rialNumber = strCurrentDate & "-" & strNextSequenti alNo
MsgBox fGenerateNextSe rialNumber
End Sub[/indent][/indent]

[ADezii]

I have a work in progress, and will probably Post it sometime this evening...

[Scott Kaempfe]

Wow! Really? Thanks! I can send you my whole file if that helps but it is probably a mess in your eyes.

[ADezii]

The following Function will:

1. Search a Table (tblTest) and see if the Date Component of any Serial Number ([Serial#]) is equal to Today's Date:
   

   'Are there any Serial Numbers for today's Date?
   intCount = DCount("*", "tblTest", "Left$([Serial#],6) = " & Format$(Date, "mmddyy"))

2. If there is no Serial Number for Today's Date the Function returns:
   

   Else                        'No Serial Number for Today's Date, so set it
     fGenerateSerialNumber = Format$(Date, "mmddyy") & "-001"
   End If

   mmddyy-001

   in this case:
   

   121710-001

3. If a Serial Number(s) exist for Today's Date, then the Code will create a Recordset filtered for Today's Date sorted by the Numeric Component of the Serial Number, namely the XXX in mmddyy-XXX:
   

   strSQL = "SELECT [Serial#] FROM tblTest WHERE Left$([Serial#],6) = '" & Format$(Date, "mmddyy") & "'" & _
            " ORDER BY Val(Right$([Serial#],3)) DESC;"

4. Notice the Sort Order is Descending on this Numeric Value, so the greatest Value is the 1st Record in the Recordset. The Code does not assume that the greatest Numeric Component of the Serial Number will always be the 'Last' Number for a given Date.
5. The Function now returns a New Serial Number, incrementing the Numeric Component by +1:
   

   If intCount > 0 Then        'Yes there is at least 1, so Increment the Last
     Set rst = CurrentDb.OpenRecordset(strSQL, dbOpenDynaset)
     fGenerateSerialNumber = Left$(rst![Serial#], 7) & Format$(Val(Right$(rst![Serial#], 3) + 1), "000")
   Else 

6. The Function in its entirety is listed below, any questions, feel free to ask.
   

   Public Function fGenerateSerialNumber() As String
   Dim intCount As Integer
   Dim rst As DAO.Recordset
   Dim strSQL As String
    
   'Are there any Serial Numbers for today's Date?
   intCount = DCount("*", "tblTest", "Left$([Serial#],6) = " & Format$(Date, "mmddyy"))
    
   'Create a Recordset based on all Records having a Serial Number consisting of Today's Date.
   'Order By the Numeric Component (XXX in mmddyy-XXX) Descending so greatest Value is the 1st
   'Record in the Recordset
   strSQL = "SELECT [Serial#] FROM tblTest WHERE Left$([Serial#],6) = '" & Format$(Date, "mmddyy") & "'" & _
            " ORDER BY Val(Right$([Serial#],3)) DESC;"
    
   If intCount > 0 Then        'Yes there is at least 1, so Increment the Last
     Set rst = CurrentDb.OpenRecordset(strSQL, dbOpenDynaset)
     fGenerateSerialNumber = Left$(rst![Serial#], 7) & Format$(Val(Right$(rst![Serial#], 3) + 1), "000")
   Else                        'No Serial Number for Today's Date, so set it
     fGenerateSerialNumber = Format$(Date, "mmddyy") & "-001"
   End If
    
   'Clean Up, if required
   If Not rst Is Nothing Then
     rst.Close
     Set rst = Nothing
   End If
   End Function

[Scott Kaempfe]

I will try it soon.

Thank you very much. I really appreciate it!

[Scott Kaempfe]

Hi.

I tried this and it worked fine when there was no record with todays date but when I put a record with today's date into the table, it gave me the following error:
"Run-Time error 3061
Too few parameters. Expected 1."

On the following line:
Set rst = CurrentDb.OpenR ecordset(strSQL , dbOpenDynaset)

[ADezii]

Post what you have for strSQL.