4

Looking to generate a unique value to save quoted orders with, allowing easy recall. Will this number ever repeat, other than when clicked within 1 second.

idNumber = Application.Worksheetfunction.Roundup(DateValue(Now) * TimeValue(Now),0)
sticky bit
  • 36,626
  • 12
  • 31
  • 42
  • how much data are we talking about here realistically ever? Max number of records? – QHarr Sep 01 '18 at 04:19
  • https://stackoverflow.com/questions/45332357/ms-access-vba-error-run-time-error-70-permission-denied – QHarr Sep 01 '18 at 10:59

5 Answers5

5

Depending on your actual needs, unique values may not need to be Long integers; if that's so then it's good to know that Windows has a built-in way (in OLE32.DLL) of generating them, that you can leverage to generate Globally Unique IDentifiers:

Private Type GUID
    Data1 As Long
    Data2 As Integer
    Data3 As Integer
    Data4(7) As Byte
End Type

Private Declare Function CoCreateGuid Lib "OLE32.DLL" (pGuid As GUID) As Long

Public Function GetGUID() As String
'(c) 2000 Gus Molina

    Dim udtGUID As GUID

    If (CoCreateGuid(udtGUID) = 0) Then

        GetGUID = _
            String(8 - Len(Hex$(udtGUID.Data1)), "0") & Hex$(udtGUID.Data1) & _
            String(4 - Len(Hex$(udtGUID.Data2)), "0") & Hex$(udtGUID.Data2) & _
            String(4 - Len(Hex$(udtGUID.Data3)), "0") & Hex$(udtGUID.Data3) & _
            IIf((udtGUID.Data4(0) < &H10), "0", "") & Hex$(udtGUID.Data4(0)) & _
            IIf((udtGUID.Data4(1) < &H10), "0", "") & Hex$(udtGUID.Data4(1)) & _
            IIf((udtGUID.Data4(2) < &H10), "0", "") & Hex$(udtGUID.Data4(2)) & _
            IIf((udtGUID.Data4(3) < &H10), "0", "") & Hex$(udtGUID.Data4(3)) & _
            IIf((udtGUID.Data4(4) < &H10), "0", "") & Hex$(udtGUID.Data4(4)) & _
            IIf((udtGUID.Data4(5) < &H10), "0", "") & Hex$(udtGUID.Data4(5)) & _
            IIf((udtGUID.Data4(6) < &H10), "0", "") & Hex$(udtGUID.Data4(6)) & _
            IIf((udtGUID.Data4(7) < &H10), "0", "") & Hex$(udtGUID.Data4(7))
    End If

End Function

source

If two values ever collide, you better have a lottery ticket!

Mathieu Guindon
  • 69,817
  • 8
  • 107
  • 235
3

Your formula is redundant. You only require:
                                     idNumber = Application.Worksheetfunction.Roundup(Date * Time, 0)

Yes, there is a possibility that it will repeat. Dates are long integers; 1 for every day past 31-Dec-1899. Time is a decimal portion of a date; e.g. noon is 0.5. Today (31-Aug-2018) at 04:00 PM is 43343.667.

So if you multiply an integer by a decimal and round up to the nearest integer then tomorrow there will be a time (i.e. decimal) that can be multiplied by day that will match.

'today at noon (rounded up)
43343 * 0.5 = 21671.5 = 21672
'tomorrow at noon (rounded up)
43344 * 0.5 = 21672 = 21672

Even without the rounding there is a slight chance that date * time can repeat; with the one-sided rounding there is a much larger chance.

Beyond basic decimal multiplied by integer duplication, it seems that it takes about 2 seconds to change the value returned by your formula. Any two event within 2 seconds runs a high risk of producing duplicates.

3

Yes, that number can potentially repeat because of the rounding. The TimeValue is always going to be a floating point number with 0 to the right of the decimal (a fractional day). So what you are basically doing is dividing the day by the time. At values close to midnight, you start approaching a divisor of 1. For example, 23:55:55 is .9971643519. Today's DateValue is 43343. If you multiple the two values and round, you get 43220, which was April 30th, 2018 at 23:59:59.

If you need to get unique integer values from the "timestamp", it would be better to simply take the underlying date\time value and scale it by the appropriate precision. A VBA Date is simply a Double with the "DateValue" portion as the integer part and the "TimeValue" to the right of the decimal. If you need a high level of precision for your unique value, you'll probably want to offset to a new epoch date so you don't risk overflowing as fast. For example, January 1st, 2018 was 43101 so you can set your "internal epoch" to that by subtracting 43101:

Public Function GetNumberFromTimestamp() As Long
    Dim current As Double
    current = CDbl(Now())
    'Set to a custom epoch
    current = current - 43101
    'Scale by whatever precision you need.
    GetNumberFromTimestamp = current * 1000000
End Function
Comintern
  • 21,855
  • 5
  • 33
  • 80
3

I use strings as ID's not numbers - because you do not do arithmetic on IDs.

However, an easy way to do a time-based ID is the scientific reverse date method. The level of precision depends on your needs. For the examples below, today is 1st September 2018 and the time is 1655 (24 hour clock) and 35 seconds.

  • (1) Only one a day: Year & Month & Day (e.g. 180901 as today is the first of September). If you want these IDs to last longer than a century, then use 4 digit years (2018 instead of 18).
  • (2) Maximum of one every hour: (1) & Hour (e.g. 18090116)
  • (3) Maximum of one every minute: (2) & minute (e.g. 1809011655)
  • (4) Maximum of one every second: (3) & seconds (e.g. 180901165535)
  • (5+) Yes, you can go to fractions of a second.

The advantage of the above scheme is that IDs can be sorted in alphabetical and numerical order (as long as you remain consistent with the length of ID in your data). For granularity down to a second you can simply use the Format(Now(),"yymmddhhnnss") command to generate the String. If you really need a number, you can convert that to a Long, confident that you have only used digits.

AJD
  • 2,400
  • 2
  • 12
  • 22
0

Thanks for all the input. Below is what is what i intend to use for my unique number. This will serve the purpose i intended. The number will repeat every 100 years, or within 1 second, but that should not an issue for how I'm using it. sheetName is delcared at the top of the userform.

    If sheetName <> "" Then
Workbooks.Open "C:\Users\jschu\Desktop\price test\Quote_Database.xlsx"
Workbooks("Quote_Database.xlsx").Sheets(sheetName).Select

Else
Workbooks.Open "C:\Users\jschu\Desktop\price test\Quote_Database.xlsx" ' Open Quote Database file

idNumber = Format(Now, "YYMMDDHHSS") ' Generate unique #
sheetName = idNumber & " " & UserForm3.nameText
    With Workbooks("Quote_Database.xlsx") ' Finds the last sheet then adds a new sheet with the idnumber and customer name
        .Sheets.Add(After:=.Sheets(.Sheets.count)).Name = sheetName
    End With
End If

Side note: special thanks to Mathieu Guindon, his answer is very robust, but a little overkill for what I'm looking for. I will have a use for this later I'm sure. Thanks!