We help IT Professionals succeed at work.

Copy Data Evenly

Cartillo
Cartillo used Ask the Experts™
on
Hi Experts,

I would like to request Experts help create a code (VBA) to automatically copy the Title (C5) at “booking” sheet  evenly according to Frequency (C11) within the Start /End Time  and Start/End Date at “Order” sheet. E.g.

Title: Title A
Start/End Date: 10-15 August
Start/End Time: 18:00-23:00
Frequency: 20

“Title A” need to copy evenly  between date 10-15 august and time frame from 1800 to 2300hrs. In other words, Title A will be appeared 20x from 10th to 15th August between 1800hrs to 2300hrs. The title can appear at any time as long as it's between the timeframe and the date. Hope Experts will help me create this feature.

OrderList.xlsx
Comment
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
Top Expert 2010

Commented:
Using your example above:

Title: Title A
Start/End Date: 10-15 August
Start/End Time: 18:00-23:00
Frequency: 20

Can the title appear for the interval that begins on 15 Aug 23:00?

Author

Commented:
Hi matthewspatrick,

The title should not appeared after 23:00hrs, but its can be scheduled anytime between 18:00hrs to 23:00hrs. Hope I have answered your question.  

Author

Commented:
Hi matthewspatrick,

Please let me know if my explanation is not very clear.
Try this macro
Sub spreaddata()
With Sheets("Booking")
    strt = CVDate(.[c7]) + IIf(.[c9] < 0.25, 0, (.[c9] - 0.25) / 0.75)
    finis = CVDate(.[e7]) + IIf(.[e9] < 0.25, 0, (.[e9] - 0.25) / 0.75)
    dur = finis - strt
    gap = dur / (.[c11] - 1)
End With
For tim = strt To finis Step gap
    sdate = Int(tim)
    stime = (tim - sdate) * 0.75 + 0.25
    cn = Sheets("Order").Range("2:2").Find(sdate).Column
    rn = WorksheetFunction.Match(stime, Sheets("Order").[A:A])
    Sheets("Order").Cells(rn, cn) = Sheets("Booking").[c5]
Next tim
End Sub

Open in new window

Author

Commented:
Hi ssaqibh,

Thanks for the code. I have tested the macro, the Title were copied outside of a specified time. Noticed the 1st data was copied at 17:50hrs (10-Aug), 11:00 (11-Aug), 12:00 (12-Aug).....by right the data should be copied between 18:00 to 23:00hrs. And, only 19 data were copied instead of 20. Please assist.
I am sorry I missed your comment. I only knew when I saw your new question.

Try this macro.
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
    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("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

It would be better if you put a pointer in the new question to give responses in this question otherwise there would be problems of cross posting. Later you can delete the new question.

Author

Commented:
Hi ssaqibh,

Thanks a lot for the revised code. Noticed the data always copied one day extra, attached the sample file. Date between 1-5 aug, but the data also copied at 6-aug. Please help to fix this.

I will delete my question, sorry.
I tried
                              
      Title:      Title A                  
                              
      Start Date:      1-Aug      End Date:      5-Aug      
                              
      Start Time:      18:00      End Time:      23:00      
                              
      Frequency:      20                  

and it worked just fine. Please give your data so that I can check that too.

Author

Commented:
Hi,

Here's the sample file that I have tested with:

Title:      Title A                  
                             
      Start Date:      1-Jan     End Date:      5-Jan
                             
      Start Time:      06:00      End Time:      10:00      
                             
      Frequency:      50      


Is that possible to retain an old data if a different title name being used on the same date/Time. Perhaps copy the new data below, like this:

Title A
Title CB

Hope you will consider this request.


OrderList.xlsm
Change

    dur = (etim - stim) * ndays

to

    dur = (etim - stim - 0.00001) * ndays

Author

Commented:
Hi ssaqibh,

Thanks a lot for helping me.