Copy Data with 24 hours time set

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'.
   
 
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.

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.  

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.

So what's the logic of the distribution?

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

Hi imnorie,

Yes, maintain the original code but extended into 24hrs. Hope this is possible.

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.

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"?

Hi imnorie,

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

Hi,

Thanks a lot for help.

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 ;-)

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

Select allOpen in new window

Hi,
Is that OK to post this solution in this Q:

https://www.experts-exchange.com/questions/27243513/Macro-not-copy-the-data-correctly.html

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

Select allOpen in new window

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

Select allOpen in new window

Hi ssaqibh,

Cool! it's work perfectly. Sorry for troubling you much with Q.

No problem, it is important to get the things right.