VBA script to create an interger value of the current date and time stamp

[KlayontKress]

I'm looking to modify a VBA code to create a unique date and time stamp. The code I have so far is

    Sheets("Route Import").Cells(x, 1).Value = Int(CDbl(Now()))

This gives me the integer value of the date but I also need the time because the macro I'm using will go to the next line and create a route id for the next person and Ineed unique values across days. Right now, the existing code

Sheets("Route Import").Cells(x, 1).Value = Round(((999 - 100 + 1) * Rnd + 100), 0) & Round(((999 - 10 + 1) * Rnd + 100), 0) & Round(((999 - 10 + 1) * Rnd + 100), 0)

is generating "Random" numbers that are repeating day to day and this is messing up the scheduling program because it's trying to add what is supposed to be a new day's route information to a past day's route because the route id's are the same. I found the code that was generating this number and had the idea of using the date time stamp to generate a unique number number but I lack the knowledge on how to get the date and time together in an integer.

The code to generate this route id repeats until it creates a unique route id for all of the service techs that day so I need it to pull the current system time to a fraction of a second (a millisecond may work) so that if it can process multiple times in a single second, each entry is unique from the others.


Any help is greatly appreciated.


Thanks,

 

[Norie]

How would you want the time represented?

This will give you the date and time as an integer.

Replace(CDbl(Now()), ".", ""))

 

[KlayontKress]

just straight numbers if possible so I;d like to see a number like 434971235011 where the 43497 is the interger of the date and the time is the 1235011 the current hour/min/sec/milsec

 

[KlayontKress]

so i put this in my cdelike this:

    Sheets("Route Import").Cells(x, 1).Value = Int(Replace(CDbl(Now()), ".", ""))

and the output is still giving me the same number "434975273032407" for all 17 iterations.

the full code I'm running to create these numbers is;

Do While Not IsEmpty(Sheets("Route Import").Cells(x, 2).Value)

    'Driver
    Sheets("Route Import").Cells(x, 1).Value = Int(Replace(CDbl(Now()), ".", ""))
    
    x = x + 1

'old code    Sheets("Route Import").Cells(x, 1).Value = Int(CDbl(Now()))
Loop

 

[shg]

  Range("A1").Value = 86400 * Now()

 

[joeu2004]

I;d like to see a number like 434971235011 where the 43497 is the interger of the date and the time is the 1235011 the current hour/min/sec/milsec

Ostensibly:

Dim t As Double, d As Double
t = Timer
d = CLng(Date) & Replace(WorksheetFunction.Text(t / 86400, "hhmmss.0"), ".", "")
MsgBox Format(t, "0.000000") & vbNewLine & d

Some notes:
1. VBA Format does not format fractional seconds (e.g. milliseconds). Hence the needed to use WorksheetFunction.Text (Excel TEXT) instead.
2. VBA Now returns date and time truncated to the second. So we cannot get milliseconds accuracy.
3. Excel TEXT(...,"hhmmss.0") rounds to the millisecond.
4. VBA Timer returns seconds accurate to the microsecond (or better), at least on PCs. (Do you use a Mac?)
5. VBA Date returns the date as integer days since 12/30/1899, not since 12/31/1899 as Excel does. But VBA Date and Excel Date agree starting with 3/1/1900 (March 1), because Excel treats 2/29/1900 as a leap day, whereas VBA does not.
6. There is a race condition when calling Timer, then Date near midnight. If that concerns you, write:

Dim t As Double, d As Double
d = Date
t = Timer
If d <> Date Then d = Date: t = Timer  ' midnight occurred
d = d & Replace(WorksheetFunction.Text(t / 86400, "hhmmss.0"), ".", "")
MsgBox Format(t, "0.000000") & vbNewLine & d

 

[joeu2004]

PS....

I;d like to see a number like 434971235011 where the 43497 is the interger of the date and the time is the 1235011 the current hour/min/sec/milsec

Dim t As Double, d As Double
t = Timer
d = CLng(Date) & Replace(WorksheetFunction.Text(t / 86400, "hhmmss.0"), ".", "")

[....]
3. Excel TEXT(...,"hhmmss.0") rounds to the millisecond.

It should be noted that 1235011 is hhmmss and 1/10 second, not milliseconds.

So as I wrote it, Excel TEXT rounds to the 1/10 second, not to the millisecond.

 

[joeu2004]

Errata....

Dim t As Double, d As Double
d = Date
t = Timer
If d <> Date Then d = Date: t = Timer  ' midnight occurred
d = d & Replace(WorksheetFunction.Text(t / 86400, "hhmmss.0"), ".", "")
MsgBox Format(t, "0.000000") & vbNewLine & d

Well, it seems that I'm capable of reproducing the same formatting defect that Excel has. We cannot round time independent of the date. If we did, the rounded time (close to midnight) might round to zero, but we would fail to round to the next date.

The correct implementation is (rounding to 1/10 second per requirement):

Dim d As Double
d = Date + WorksheetFunction.Round(10 * Timer, 0) / 864000
If Int(d) <> Date Then d = Date + WorksheetFunction.Round(10 * Timer, 0) / 864000  ' midnight occurred
d = Int(d) & Replace(WorksheetFunction.Text(d, "hhmmss.0"), ".", "")
MsgBox d

Note: I use Excel ROUND (WorksheetFunction.Round) instead of VBA Round because the latter does "banker's rounding".

 

[joeu2004]

Improved....

Dim d As Double
d = Date + WorksheetFunction.Round(Timer, 1) / 86400
If Int(d) <> Date Then d = Date + WorksheetFunction.Round(Timer, 1) / 86400  ' midnight occurred
d = Int(d) & Replace(WorksheetFunction.Text(d, "hhmmss.0"), ".", "")
MsgBox d

 

[KlayontKress]

much appreciated for the work.