Avatar of Cartillo
Cartillo
Flag for Malaysia asked on

Copy Data with 24 hours time set

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
Microsoft Excel

Avatar of undefined
Last Comment
Saqib Husain

8/22/2022 - Mon
Norie

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

ASKER
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.  
SOLUTION
Norie

Log in or sign up to see answer
Become an EE member today7-DAY FREE TRIAL
Members can start a 7-Day Free trial then enjoy unlimited access to the platform
Sign up - Free for 7 days
or
Learn why we charge membership fees
We get it - no one likes a content blocker. Take one extra minute and find out why we block content.
Not exactly the question you had in mind?
Sign up for an EE membership and get your own personalized solution. With an EE membership, you can ask unlimited troubleshooting, research, or opinion questions.
ask a question
Cartillo

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

This is the best money I have ever spent. I cannot not tell you how many times these folks have saved my bacon. I learn so much from the contributors.
rwheeler23
Norie

So what's the logic of the distribution?

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

ASKER
Hi imnorie,

Yes, maintain the original code but extended into 24hrs. Hope this is possible.
ASKER CERTIFIED SOLUTION
Log in to continue reading
Log In
Sign up - Free for 7 days
Get an unlimited membership to EE for less than $4 a week.
Unlimited question asking, solutions, articles and more.
Norie

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.
Get an unlimited membership to EE for less than $4 a week.
Unlimited question asking, solutions, articles and more.
Cartillo

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

Cartillo

ASKER
Hi imnorie,

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

ASKER
Hi,

Thanks a lot for help.
Your help has saved me hundreds of hours of internet surfing.
fblack61
Norie

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.:)
Saqib Husain

Looks like Cartillo understood the idea of "Split" loud and clear ;-)
Cartillo

ASKER
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.
Get an unlimited membership to EE for less than $4 a week.
Unlimited question asking, solutions, articles and more.
Saqib Husain

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

Cartillo

ASKER
Cartillo

ASKER
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?
All of life is about relationships, and EE has made a viirtual community a real community. It lifts everyone's boat
William Peck
Saqib Husain

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

Cartillo

ASKER
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.
Saqib Husain

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

Get an unlimited membership to EE for less than $4 a week.
Unlimited question asking, solutions, articles and more.
Cartillo

ASKER
Hi ssaqibh,

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

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