Results 1 to 2 of 2
  1. #1
    Join Date
    Mar 2011
    Posts
    4

    Unanswered: Working out delivery dates

    Hi,

    I have a project where a customer can say when they would like a delivery. They can choose a day of the week and select how often they want the delivery e.g. every week, two weeks, three weeks ect.

    The administrator then selects a date and see what deliveries there are on that date. I also want the admin to be able put in order the deliveries for that date.

    I'm not sure the best way to tackle this. I have done many ordering systems but can't seem to think of an efficient way to work out the dates. A simple solution would be to get the admin to add all the dates a delivery is required, but that would be tedious and need updating.

    Any advice and snippets would be appreciated.

    Thanks

  2. #2
    Join Date
    Mar 2009
    Posts
    5,442
    Provided Answers: 14
    Here's a possible solution:
    Code:
    Public Function ComputeDeliveryDates(ByVal DeliveryDay As Long, _
                                         ByVal Periodicity As Long, _
                                         ByVal StartDate As Date, _
                                         ByVal EndDate As Date) _
        As Variant
    
    ' DeliveryDay:  Day of Week (DoW) for Delivery (Modified on 2004-05-19 --> ISO Standard, see hereafter).
    ' Periodicity:  In weeks (1 = every week, 2 = every 2 weeks, etc.).
    ' Startdate:    First day of the delivery period (can be before the first delivery date).
    ' EndDate:      Last day of the delivery period  (can be after the last delivery date).
    '
    ' ISO/FDIS 8601:2000(E) ( ISO 2000  All rights reserved)
    ' =======================================================
    '
    ' 4.3.2.2 The calendar week
    ' -------------------------
    '
    ' In parallel with the reference system described in 4.3.2.1, there is a reference
    ' system based on an unbounded series of contiguous calendar weeks.
    '
    ' Each calendar week has seven calendar days as indicated in Table 2.
    '
    ' Table 2:  Calendar days
    ' -----------------------
    '
    ' +---------------+--------------+
    ' | Ordinal day   | Calendar day |
    ' | number in     | name         |
    ' | the week      |              |
    ' +---------------+--------------+
    ' |     01        |  Monday      |
    ' |     02        |  Tuesday     |
    ' |     03        |  Wednesday   |
    ' |     04        |  Thursday    |
    ' |     05        |  Friday      |
    ' |     06        |  Saturday    |
    ' |     07        |  Sunday      |
    ' +---------------+--------------+
    '
        Dim StartDateDay As Long
        Dim DeltaDay As Long
        Dim DeliveryDate As Date
        Dim FirstDeliveryDate As Date
        Dim DeliveryList() As Date
        Dim DeliveryCount As Long
        
        If DeliveryDay < 1 Or DeliveryDay > 7 Then Exit Function    ' Accepted values for the Dow are between 1 and 7 (Mon to Sun).
        If Periodicity < 1 Then Exit Function                       ' Min. periodicity is one week.
        StartDateDay = DatePart("w", StartDate, vbMonday)           ' DoW for StartDate (now ISO Standard, see above).
        DeltaDay = DeliveryDay - StartDateDay                       ' Difference in days between Delivery Dow and First day
                                                                    ' of the delivery period Dow.
        If DeltaDay < 0 Then DeltaDay = 7 + DeltaDay                ' Correction to find the DoW nearest to the First day
                                                                    ' of the delivery period.
        FirstDeliveryDate = StartDate + DeltaDay                    ' First effective date of delivery.
        For DeliveryDate = CLng(FirstDeliveryDate) To CLng(EndDate) Step 7 * Periodicity
            If DeliveryDate <= EndDate Then                         ' Last iteration can be out of the delivery time slot.
                ReDim Preserve DeliveryList(0 To DeliveryCount)
                DeliveryList(DeliveryCount) = DeliveryDate
                DeliveryCount = DeliveryCount + 1
            End If
        Next DeliveryDate
        ComputeDeliveryDates = DeliveryList                         ' Return the array of delivery dates (0 to n).
        
    End Function
    You can test it using:
    Code:
    Function TestComputeDeliveryDates()
    
        Dim i As Integer
        Dim l As Variant
        
        l = ComputeDeliveryDates(1, 2, #3/15/2010#, #8/31/2010#)
        For i = 0 To UBound(l)
            Debug.Print l(i)
        Next i
        
    End Function
    Have a nice day!

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •