troubleshooting Question

Copy Data at the variety time

Avatar of Cartillo
CartilloFlag for Malaysia asked on
Microsoft Excel
18 Comments3 Solutions380 ViewsLast Modified:
Hi Experts,

How to make the attached script able to copy booking (title) in a different time slot at the order sheet so that each day the "title" will be appearing at a different time? The time should be between Start/End Time at cell C9&E9(Booking sheet)

Sub spreaddatatest()
Dim start_date As Date, start_time As Date
Dim end_date As Date, end_time As Date
Dim booking_date As Date, booking_time As Date
Dim duration As Date, gap As Date
Dim number_of_days As Integer
Dim frequency As Integer
Dim booking As Integer, booking_column As Integer, booking_row As Integer
Dim last_booking_row As Integer
Dim end_time_column As Integer
Dim prevent_double_bookings As Boolean
Dim result

With Sheets("Booking")
    '-- initialise
    start_date = CDate(.[c7])
    end_date = CDate(.[e7])
    start_time = CDate(.[c9])
    end_time = CDate(.[e9])
    prevent_double_bookings = True
    '-- before 6 o'clock = next day
    If start_time < TimeValue("06:00:00") Then start_time = start_time + 1
    If end_time < TimeValue("06:00:00") Then end_time = end_time + 1
    If end_time < start_time Then MsgBox ("Starting time is higher that ending time"): End
    '-- calculate time span
    number_of_days = end_date - start_date + 1
    duration = (end_time - start_time) * number_of_days - 0.0001
    frequency = .[c11]
    If frequency > 1 Then gap = duration / frequency
End With

booking_date = start_date
booking_time = start_time
last_booking_row = Sheets("Order").Range("A:A").Find(what:=end_time - WorksheetFunction.Floor(end_time, 1), lookat:=xlWhole).Row
end_time_column = Sheets("Order").Range("2:2").Find(end_date).Column
For booking = 1 To frequency
    '-- locate booking position
    booking_column = Sheets("Order").Range("2:2").Find(booking_date).Column
    booking_row = (booking_time - TimeValue("6:00:00")) * 24 * 6 + 3
    '-- prevent double bookings where possible
    While prevent_double_bookings = True And Sheets("Order").Cells(booking_row, booking_column) <> ""
        booking_row = booking_row + 1
        If booking_row > last_booking_row Then
            booking_column = booking_column + 1
            booking_row = Sheets("order").Range("A:A").Find(what:=start_time, lookat:=xlWhole).Row
        End If
        '-- when booking extends end date, evenly disperse remaining bookings over complete interval
        If booking_column > end_time_column Then
                booking_date = start_date
                booking_time = start_time
                frequency = frequency - booking + 1
                gap = duration / frequency
                booking = 1
                prevent_double_bookings = False
                GoTo loop_process_bookings
        End If
    '-- add booking to orders
    Sheets("Order").Cells(booking_row, booking_column) = Sheets("Order").Cells(booking_row, booking_column) & vbCrLf & Sheets("Booking").[c5]
    '-- determine next booking
    booking_time = booking_time + gap
    While booking_time > end_time
        booking_date = booking_date + 1
        booking_time = booking_time - end_time + start_time
Next booking

End Sub
Saqib Husain

Our community of experts have been thoroughly vetted for their expertise and industry experience.

Join our community to see this answer!
Unlock 3 Answers and 18 Comments.
Start Free Trial
Learn from the best

Network and collaborate with thousands of CTOs, CISOs, and IT Pros rooting for you and your success.

Andrew Hancock - VMware vExpert
See if this solution works for you by signing up for a 7 day free trial.
Unlock 3 Answers and 18 Comments.
Try for 7 days

”The time we save is the biggest benefit of E-E to our team. What could take multiple guys 2 hours or more each to find is accessed in around 15 minutes on Experts Exchange.

-Mike Kapnisakis, Warner Bros