PDA

View Full Version : [SOLVED] Automatic Generate random unique time From 8 AM till 21 PM in range



parscon
03-15-2014, 05:55 PM
I need a VBA code that can generate Time like hh:mm:ss that start from 8 Am till 21 PM in 170 row in column A

the important thing is when generate random time in 170 row each time must have minimum 4 minute different with another time and all of them must be unique.

Please help me.

Thank you.

westconn1
03-15-2014, 10:07 PM
try like

Dim c As Collection
Set c = New Collection
l = 8 * 15
u = 21 * 15

rw = 1
Randomize
On Error Resume Next
Do
num = Int((u - l + 1) * Rnd + l)


c.Add num, CStr(num)
If Err.Number = 0 Then
rw = rw + 1
Else
errcnt = errcnt + 1
Err.Clear
End If
Loop Until rw = 171
For rw = 1 To 170
Cells(rw, 1) = TimeSerial(c(rw) \ 15, (c(rw) Mod 15) * 4, 0)
Next

parscon
03-15-2014, 11:58 PM
Thank you very much .

Work Very Fine and really you saved me. just the seconds are 00 can you do some thing show random numbers in seconds also ?

Best Regards

westconn1
03-16-2014, 01:04 AM
if you randomise the seconds as well, there may not be enough times slots for the 4 minute increments

you can test this, but you will need to check the results

Dim c As Collection
Set c = New Collection
l = 8 * 15 * 60
u = 21 * 15 * 60

rw = 1
Randomize
On Error Resume Next
Do
num = Int((u - l + 1) * Rnd + l)


c.Add num, CStr(num)
If Err.Number = 0 Then
rw = rw + 1
Else
errcnt = errcnt + 1
Err.Clear
End If
Loop Until rw = 171
On Error GoTo 0

For rw = 1 To 170

Cells(rw, 4).Value = TimeSerial(c(rw) \ (60 * 15), ((c(rw) \ 60) Mod 15) * 4, c(rw) Mod 60)
Next

parscon
03-16-2014, 01:21 AM
Thank you very much , it is work but it will passed 4 min, i will use post 2 and generate random number manually for second.

Thank you again

westconn1
03-16-2014, 01:28 AM
any random seconds added to the time may reduce the time difference to less than 4 minutes

another option maybe to generate an incrementing array of times, then randomise the array

parscon
03-16-2014, 01:33 AM
Thank you very much . it is your kind that help people.

SamT
03-16-2014, 11:55 AM
Need Random doubles between 0.333333333333333 and 0.958333333333333 with an difference of at least 0.5027778

snb
03-16-2014, 02:10 PM
Without VBA see the attachment