We help IT Professionals succeed at work.

Copy Data with 24 hours time set

Cartillo
Cartillo used Ask the Experts™
on
Hi Experts,

I would like to request Experts help to add additional feature in the attached macro. Currently the macro only able to copy data from Booking sheet (cell C5) to Order sheet based on Date, Frequency and Time between 06:00 to 00:00hrs. Intent to expend the duration from 06:00am hrs to 05:50hrs (24hrs). Hope Experts will help to add this feature so that the data can be copied based on 24 hours interval.



Sub spreaddata()
With Sheets("Booking")
    sdat = CVDate(.[c7])
    edat = CVDate(.[e7])
    stim = CVDate(.[c9])
    etim = CVDate(.[e9])
    ndays = edat - sdat + 1
    'dur = (etim - stim) * ndays
    dur = (etim - stim - 0.00001) * ndays
    ns = .[c11]
    Gap = dur / (ns - 1)
End With
dat = sdat
tim = stim
For sh = 1 To ns
    cn = Sheets("Order").Range("2:2").Find(dat).Column
    rn = (tim - 0.25) * 24 * 6 + 3
    Sheets("Order").Cells(rn, cn) = Sheets("Order").Cells(rn, cn) & vbCrLf & Sheets("Booking").[c5]
    If tim + Gap > etim Then
    dat = dat + 1
    tim = tim + Gap - etim + stim
    Else
    tim = tim + Gap
    End If
Next sh
End Sub

Open in new window

OrderList.xlsm
Comment
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
NorieAnalyst Assistant

Commented:
Cartillo

Is the current code actually working correctly?

I looked at the original workbook and it appeared to be entering bookings 'diagonally'.

eg on 1-Jan there was a booking for A at 10:00, then on Jan-2 there was no booking at 10:00 but a booking at 10:00

Is that how you actually need things?

I would have thought you would have a booking would be in a 'block' for each day.

eg from 10:00 to 15:00 on 1-Jan, 2-Jan, 3-Jan etc

Perhaps the attached image will explain what I mean by 'block'.
   
 Block Booking
I've actually created code that will do the above, and I think it could be extended to cover 24 hours without too much change.

Author

Commented:
Hi imnorie,

Sounds good, can I tested your suggested code? The current code works based on booking Date and Time and the data need to copy according to frequency (evenly arrange between date and time) and make sure the total data that were copied not more than the frequency that was set.  
NorieAnalyst Assistant
Commented:
Are you sure the image I attached is what you want?

Or do you need something else?

I'll attach the workbook with the altered code but I think you need to check it out as I've got  a feeling it's not what
you want.
OrderList-EE.xlsm

Author

Commented:
Hi imnorie,

You're right. Even though the data were copied at the right date and time, but having a wrong total (Frequency). E.g. if

Title: Title A
Start/End Date: 01 - 03 Jan
Start/End Time: 10:00 - 15:00
Frequency: 30

From 01-03 Jan and between 10:00 - 15:00,  total of  30x "Title A" should be booked. "Title A" should not copy more than 30x from 01-03 Jan (the data evenly segregate between 10:00 - 15:00 from 01 - 03 Jan).   Sorry if my explanation creates confusion.

NorieAnalyst Assistant

Commented:
So what's the logic of the distribution?

Should it be staggered like the original code seemed to be doing?

Author

Commented:
Hi imnorie,

Yes, maintain the original code but extended into 24hrs. Hope this is possible.
Try
Sub spreaddata()
With Sheets("Booking")
    sdat = CVDate(.[c7])
    edat = CVDate(.[e7])
    stim = CVDate(.[c9])
    If stim < 0.25 Then stim = stim + 1
    etim = CVDate(.[e9])
    If etim < 0.25 Then etim = etim + 1
    ndays = edat - sdat + 1
    If etim < stim Then MsgBox ("Starting time is higher that ending time"): End
    dur = (etim - stim - 0.00001) * ndays
    ns = .[c11]
    Gap = dur / (ns - 1)
End With
dat = sdat
tim = stim
For sh = 1 To ns
    cn = Sheets("Order").Range("2:2").Find(dat).Column
    rn = (tim - 0.25) * 24 * 6 + 3
    Sheets("Order").Cells(rn, cn) = Sheets("Order").Cells(rn, cn) & vbCrLf & Sheets("Booking").[c5]
    If tim + Gap > etim Then
    dat = dat + 1
    tim = tim + Gap - etim + stim
    Else
    tim = tim + Gap
    End If
Next sh
End Sub

Open in new window

NorieAnalyst Assistant

Commented:
cartillo

I still don't quite get the pattern.

Why not split the period and frequency over the 3 days, and then distribute the allocated period for each day evenly?

If that's not what's required perhaps ssaqibh's will do the job.

Author

Commented:
Hi imnorie,

I'm not very sure how this method works "split the period and frequency over the 3 days, and then distribute the allocated period for each day evenly"?

Author

Commented:
Hi imnorie,

have tested ssaqibh's code and it's just nice to produce the result.

Author

Commented:
Hi,

Thanks a lot for help.
NorieAnalyst Assistant

Commented:
Perhaps I didn't explain very well, or I've missed something.

Let's take the example of frequency 30 over 3 days.

Split that into 10 per day and then distribute over the day within the specified time period.

Anyway, that was my idea.:)
Looks like Cartillo understood the idea of "Split" loud and clear ;-)

Author

Commented:
Hi ssaqibh,

I need your help. When I update this sample data:

Title: Title A
Start/End Date: 01 - 06 Jan
Start/End Time: 18:00 - 01:00
Frequency: 4

I noticed the  first 2 data copied at the right time but the another 2 data were copied outside of data and timing area. Hope you could help me to fix this. Sorry, I just realized this.
Modified the sub
Sub spreaddata()
With Sheets("Booking")
    sdat = CVDate(.[c7])
    edat = CVDate(.[e7])
    stim = CVDate(.[c9])
    If stim < 0.25 Then stim = stim + 1
    etim = CVDate(.[e9])
    If etim < 0.25 Then etim = etim + 1
    ndays = edat - sdat + 1
    If etim < stim Then MsgBox ("Starting time is higher than ending time"): End
    dur = (etim - stim - 0.00001) * ndays
    ns = .[c11]
    Gap = dur / (ns - 1)
End With
dat = sdat
tim = stim
For sh = 1 To ns
    cn = Sheets("Order").Range("2:2").Find(dat).Column
    rn = (tim - 0.25) * 24 * 6 + 3
    Sheets("Order").Cells(rn, cn) = Sheets("Order").Cells(rn, cn) & vbCrLf & Sheets("Booking").[c5]
    If tim + Gap > etim Then
    dat = dat + 1
    tim = tim + Gap - etim + stim
    Do While tim > etim
    dat = dat + 1
    tim = tim - etim + stim
    Loop
    Else
    tim = tim + Gap
    End If
Next sh
End Sub

Open in new window

Author

Commented:
Hi,
Thanks for the revised script. Error message pop up with “Division by Zero” at this line “Gap = dur / (ns - 1)” when the frequency is “1”. E.g.

Title: TitleD
Start Date/End: 1-dec (One day)
Start Time/End: 18:00-01:00
Frequency: 1

Is that way to allow booking on the same day for single entry?
Modified for frequency 1


Sub spreaddata()
With Sheets("Booking")
    sdat = CVDate(.[c7])
    edat = CVDate(.[e7])
    stim = CVDate(.[c9])
    etim = CVDate(.[e9])
    ndays = edat - sdat + 1
    'dur = (etim - stim) * ndays
    dur = (etim - stim - 0.00001) * ndays
    ns = .[c11]
End With
If ns = 1 Then
        cn = Sheets("Order").Range("2:2").Find(sdat).Column
        rn = (stim - 0.25) * 24 * 6 + 3
        Sheets("Order").Cells(rn, cn) = Sheets("Order").Cells(rn, cn) & vbCrLf & Sheets("Booking").[c5]
Else
    Gap = dur / (ns - 1)
    dat = sdat
    tim = stim
    For sh = 1 To ns
        cn = Sheets("Order").Range("2:2").Find(dat).Column
        rn = (tim - 0.25) * 24 * 6 + 3
        Sheets("Order").Cells(rn, cn) = Sheets("Order").Cells(rn, cn) & vbCrLf & Sheets("Booking").[c5]
        If tim + Gap > etim Then
        dat = dat + 1
        tim = tim + Gap - etim + stim
        Else
        tim = tim + Gap
        End If
    Next sh
End If
End Sub

Open in new window

Author

Commented:
Hi,

Thanks for revised code, is that any possible to run this code with other frequency, when I tested with Frequency 5, it show "Application-define error" at

"Sheets("Order").Cells(rn, cn) = Sheets("Order").Cells(rn, cn) & vbCrLf & Sheets("Booking").[c5]"

When I tested with  "Frequency 20", its copied outside of date and time.
I am confusing so many versions. I did the last change using a previous version instead of the later version. Now try this
Sub spreaddata()
With Sheets("Booking")
    sdat = CVDate(.[c7])
    edat = CVDate(.[e7])
    stim = CVDate(.[c9])
    If stim < 0.25 Then stim = stim + 1
    etim = CVDate(.[e9])
    If etim < 0.25 Then etim = etim + 1
    ndays = edat - sdat + 1
    If etim < stim Then MsgBox ("Starting time is higher than ending time"): End
    dur = (etim - stim - 0.00001) * ndays
    ns = .[c11]
End With
If ns = 1 Then
        cn = Sheets("Order").Range("2:2").Find(sdat).Column
        rn = (stim - 0.25) * 24 * 6 + 3
        Sheets("Order").Cells(rn, cn) = Sheets("Order").Cells(rn, cn) & vbCrLf & Sheets("Booking").[c5]
Else
    Gap = dur / (ns - 1)
    dat = sdat
    tim = stim
    For sh = 1 To ns
        cn = Sheets("Order").Range("2:2").Find(dat).Column
        rn = (tim - 0.25) * 24 * 6 + 3
        Sheets("Order").Cells(rn, cn) = Sheets("Order").Cells(rn, cn) & vbCrLf & Sheets("Booking").[c5]
        If tim + Gap > etim Then
        dat = dat + 1
        tim = tim + Gap - etim + stim
        Do While tim > etim
        dat = dat + 1
        tim = tim - etim + stim
        Loop
        Else
        tim = tim + Gap
        End If
    Next sh
End If
End Sub

Open in new window

Author

Commented:
Hi ssaqibh,

Cool! it's work perfectly. Sorry for troubling you much with Q.
No problem, it is important to get the things right.