Allow multiple data entry in a single cell

Hi Experts,

I would like to request Experts help to add an additional feature in the attached script. The script is being used to copy data from Booking Sheet (Title – Cell C5) into Order Sheet based on information at Start/End Date, Start/End Time and the frequency (condition). Total data (Title) that need to copy  at Order sheet is determined based on the number that was entered in Frequency cell (C11).  

The current limitation with this code is, the code enables booking after the end date & time whenever no other valid options have been found. E.g. (Please refer the attached Workbook at “Order Sheet”) Title C is being booked for 1st and 2nd Jan at 06:00 to 10:00 with frequency 20. By right, this title needs to be copied between this date/time. Since there isn’t any other valid option, the balance of the data automatically copied at 3rd Jan, which is outside of booking date. Is that any possibilities the macro should be able to segregate the balance of the data between 1st and 2nd (date/time) by allowing multiple entries in the cells? E.g. Cell, B5 and C9 have shared Title C (two data in a single cell).

Hope Experts will help me to create this feature.

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

With Sheets("Booking")
    '-- initialise
    start_date = CDate(.[c7])
    end_date = CDate(.[e7])
    start_time = CDate(.[c9])
    end_time = CDate(.[e9])
    
    '-- 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.00001
    frequency = .[c11]
    If frequency > 1 Then gap = duration / frequency
End With

booking_date = start_date
booking_time = start_time
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
    last_booking_row = Sheets("Order").Range("A:A").Find(what:=end_time - WorksheetFunction.Floor(end_time, 1), lookat:=xlWhole).Row
    While 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
    Wend
    
    '-- 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
    Wend
Next booking

End Sub

Select allOpen in new window

OrderList-V3.xlsm