Consulting

Results 1 to 3 of 3

Thread: Solved: Loop Optimization Challenge

  1. #1
    VBAX Tutor jamescol's Avatar
    Joined
    May 2004
    Location
    Charlotte, NC
    Posts
    251
    Location

    Solved: Loop Optimization Challenge

    Here is a procedure I've been trying to optimize for a few days. I have not been able to determine a way to use a For Next or other looping statement to shorten the procedure.

    The scenario:
    Surveys are sent twice a year, on the 1st day of the 4th and 9th month of a contract. If the contract's starting date falls on or after the 15th of the month, then the surveys are sent on the 1st day ofthe 5th and 10th month instead.

    After the intial survey, 3 reminders are sent to the recipient: on the 15th of the survey month, the 1st of the following month, and the 15th of the following month. So basically every two weeks after the intial survey.

    This procedure calculates reminder dates for the person sending the surveys. Besides the actual survey date and follow up reminders, there is also a reminder scheduled 30 prior to the initial survey. So there are 5 reminders for each survey period:

    30 Day
    First Notice
    Second Notice
    Third Notice
    Fourth Notice

    There are two values for each reminder: the reminder date and a flag used to enable a control. I use a multi-dimensioned array to store the values.

    If there is not enough time for to schedule the reminder (defined as within 3 days of the event), then I need to store a Null for the date, and a STATUS_NOT_SET for the flag.

    Anyone up to the challenge!

    James

    [vba]
    '=============================================================
    ' CalcSurveyDates()
    '-------------------------------------------------------------
    ' Purpose : Calculate the default survey dates
    ' Args : dtStartDate
    '-------------------------------------------------------------
    '=============================================================
    Sub CalcSurveyDates(dtStartDate As Date)


    Dim i As Integer
    Dim dtReminderDate As Date
    Dim dtAdjustedStartDate As Date

    If Day(dtStartDate) < 15 Then
    'The survey is in the 4th contract month
    'Set the dtAdjustedStartDate to the first day of the current dtStartDate month
    dtAdjustedStartDate = DateAdd(Day_IntervalType, -(Day(dtStartDate) - 1), dtStartDate)

    Else
    'The survey is in the 5th contract month
    'Set the dtAdjustedStartDate to the first day of the following dtStartDate month
    dtAdjustedStartDate = DateAdd(Day_IntervalType, -(Day(dtStartDate) - 1), dtStartDate)
    dtAdjustedStartDate = DateAdd(Month_IntervalType, (Day(dtStartDate) - 1), dtStartDate)

    End If

    i = 1

    'Determine Day30 Reminder
    dtReminderDate = DateAdd(Month_IntervalType, 2, dtAdjustedStartDate)

    'Check to see how far apart the Day 30 reminder date is from today's date
    If DateDiff(Day_IntervalType, dtReminderDate, Date) >= MIN_REMINDER_DAYS Then

    'There is suffucient time to schedule the survey reminder, so store the date
    'and set status in the array

    arraySurveyDates(i, 1) = AdjustWeekendDate(dtReminderDate)
    arraySurveyDates(i, 2) = STATUS_SET


    Else
    'Not enough time for the reminder, so set the date to null and checkbox flag to false
    arraySurveyDates(i, 1) = vbNull
    arraySurveyDates(i, 2) = STATUS_NOT_SET

    End If

    'Increase counter for next array element
    i = i + 1
    'Determine FirstNotice Reminder
    dtReminderDate = DateAdd(Month_IntervalType, 1, dtReminderDate)

    'Check to see how far apart the First Notice reminder date is from today's date
    If DateDiff(Day_IntervalType, dtReminderDate, Date) >= MIN_REMINDER_DAYS Then

    'There is suffucient time to schedule the survey reminder, so store the date
    'and set status in the array

    arraySurveyDates(i, 1) = AdjustWeekendDate(dtReminderDate)
    arraySurveyDates(i, 2) = STATUS_SET

    Else
    'Not enough time for the reminder, so set the date to null and checkbox flag to false
    arraySurveyDates(i, 1) = vbNull
    arraySurveyDates(i, 2) = STATUS_NOT_SET

    End If

    'Increase counter for next array element
    i = i + 1

    'Determine SecondNotice Reminder
    dtReminderDate = DateAdd(Day_IntervalType, 14, dtReminderDate)

    'Check to see how far apart the Second Notice reminder date is from today's date
    If DateDiff(Day_IntervalType, dtReminderDate, Date) >= MIN_REMINDER_DAYS Then

    'There is suffucient time to schedule the survey reminder, so store the date
    'and set status in the array

    arraySurveyDates(i, 1) = AdjustWeekendDate(dtReminderDate)
    arraySurveyDates(i, 2) = STATUS_SET

    Else
    'Not enough time for the reminder, so set the date to null and checkbox flag to false
    arraySurveyDates(i, 1) = vbNull
    arraySurveyDates(i, 2) = STATUS_NOT_SET

    End If

    'Increase counter for next array element
    i = i + 1
    'Determine Third Notice Reminder
    dtReminderDate = DateAdd(Month_IntervalType, 4, dtAdjustedStartDate)


    'Check to see how far apart the Third Notice reminder date is from today's date
    If DateDiff(Day_IntervalType, dtReminderDate, Date) >= MIN_REMINDER_DAYS Then

    'There is suffucient time to schedule the survey reminder, so store the date
    'and set status in the array

    arraySurveyDates(i, 1) = AdjustWeekendDate(dtReminderDate)
    arraySurveyDates(i, 2) = STATUS_SET

    Else
    'Not enough time for the reminder, so set the date to null and checkbox flag to false
    arraySurveyDates(i, 1) = vbNull
    arraySurveyDates(i, 2) = STATUS_NOT_SET

    End If

    'Increase counter for next array element
    i = i + 1
    'Determine Fourth Notice Reminder
    dtReminderDate = DateAdd(Day_IntervalType, 14, dtReminderDate)


    'Check to see how far apart the Fourth Notice reminder date is from today's date
    If DateDiff(Day_IntervalType, dtReminderDate, Date) >= MIN_REMINDER_DAYS Then

    'There is suffucient time to schedule the survey reminder, so store the date
    'and set status in the array

    arraySurveyDates(i, 1) = AdjustWeekendDate(dtReminderDate)
    arraySurveyDates(i, 2) = STATUS_SET

    Else
    'Not enough time for the reminder, so set the date to null and checkbox flag to false
    arraySurveyDates(i, 1) = vbNull
    arraySurveyDates(i, 2) = STATUS_NOT_SET

    End If

    'Increase counter for next array element
    i = i + 1
    'Determine Day 30 reminder for the 9 month survey
    dtReminderDate = DateAdd(Month_IntervalType, 8, dtAdjustedStartDate)


    'Check to see how far apart the Day 30 reminder date is from today's date
    If DateDiff(Day_IntervalType, dtReminderDate, Date) >= MIN_REMINDER_DAYS Then

    'There is suffucient time to schedule the survey reminder, so store the date
    'and set status in the array

    arraySurveyDates(i, 1) = AdjustWeekendDate(dtReminderDate)
    arraySurveyDates(i, 2) = STATUS_SET

    Else
    'Not enough time for the reminder, so set the date to null and checkbox flag to false
    arraySurveyDates(i, 1) = vbNull
    arraySurveyDates(i, 2) = STATUS_NOT_SET

    End If

    'Increase counter for next array element
    i = i + 1

    'Determine First Notice reminder for the 9 month survey
    dtReminderDate = DateAdd(Month_IntervalType, 1, dtReminderDate)


    'Check to see how far apart the First Notice reminder date is from today's date
    If DateDiff(Day_IntervalType, dtReminderDate, Date) >= MIN_REMINDER_DAYS Then

    'There is suffucient time to schedule the survey reminder, so store the date
    'and set status in the array

    arraySurveyDates(i, 1) = AdjustWeekendDate(dtReminderDate)
    arraySurveyDates(i, 2) = STATUS_SET

    Else
    'Not enough time for the reminder, so set the date to null and checkbox flag to false
    arraySurveyDates(i, 1) = vbNull
    arraySurveyDates(i, 2) = STATUS_NOT_SET

    End If

    'Increase counter for next array element
    i = i + 1

    'Determine Second Notice reminder for the 9 month survey
    dtReminderDate = DateAdd(Day_IntervalType, 14, dtReminderDate)


    'Check to see how far apart the Second Notice reminder date is from today's date
    If DateDiff(Day_IntervalType, dtReminderDate, Date) >= MIN_REMINDER_DAYS Then

    'There is suffucient time to schedule the survey reminder, so store the date
    'and set status in the array

    arraySurveyDates(i, 1) = AdjustWeekendDate(dtReminderDate)
    arraySurveyDates(i, 2) = STATUS_SET

    Else
    'Not enough time for the reminder, so set the date to null and checkbox flag to false
    arraySurveyDates(i, 1) = vbNull
    arraySurveyDates(i, 2) = STATUS_NOT_SET

    End If

    'Increase counter for next array element
    i = i + 1

    'Determine Third Notice reminder for the 9 month survey
    dtReminderDate = DateAdd(Month_IntervalType, 9, dtAdjustedStartDate)


    'Check to see how far apart the Third Notice reminder date is from today's date
    If DateDiff(Day_IntervalType, dtReminderDate, Date) >= MIN_REMINDER_DAYS Then

    'There is suffucient time to schedule the survey reminder, so store the date
    'and set status in the array

    arraySurveyDates(i, 1) = AdjustWeekendDate(dtReminderDate)
    arraySurveyDates(i, 2) = STATUS_SET

    Else
    'Not enough time for the reminder, so set the date to null and checkbox flag to false
    arraySurveyDates(i, 1) = vbNull
    arraySurveyDates(i, 2) = STATUS_NOT_SET

    End If

    'Increase counter for next array element
    i = i + 1

    'Determine Fourth Notice reminder for the 9 month survey
    dtReminderDate = DateAdd(Day_IntervalType, 14, dtReminderDate)


    'Check to see how far apart the Fourth Notice reminder date is from today's date
    If DateDiff(Day_IntervalType, dtReminderDate, Date) >= MIN_REMINDER_DAYS Then

    'There is suffucient time to schedule the survey reminder, so store the date
    'and set status in the array

    arraySurveyDates(i, 1) = AdjustWeekendDate(dtReminderDate)
    arraySurveyDates(i, 2) = STATUS_SET

    Else
    'Not enough time for the reminder, so set the date to null and checkbox flag to false
    arraySurveyDates(i, 1) = vbNull
    arraySurveyDates(i, 2) = STATUS_NOT_SET

    End If



    End Sub
    [/vba]
    "All that's necessary for evil to triumph is for good men to do nothing."

  2. #2
    VBAX Regular
    Joined
    Jun 2004
    Posts
    14
    Location
    I would come at it from something like this:

    [VBA]
    Sub CalcSurveyDates(dtStartDate As Date)


    Dim i As Integer
    Dim dtReminderDate As Date
    Dim dtAdjustedStartDate As Date

    If Day(dtStartDate) < 15 Then
    'The survey is in the 4th contract month
    'Set the dtAdjustedStartDate to the first day of the current dtStartDate month
    dtAdjustedStartDate = DateSerial(Year(dtStartDate), Month(dtStartDate), 1)

    Else
    'The survey is in the 5th contract month
    'Set the dtAdjustedStartDate to the first day of the following dtStartDate month
    dtAdjustedStartDate = DateSerial(Year(dtStartDate), Month(dtStartDate) + 1, 1)

    End If

    arraySurveyDates(1, 1) = AdjustWeekendDate(DateAdd(Month_IntervalType, 2, dtAdjustedStartDate))
    arraySurveyDates(2, 1) = AdjustWeekendDate(DateAdd(Month_IntervalType, 3, dtAdjustedStartDate))
    arraySurveyDates(3, 1) = AdjustWeekendDate(DateAdd(Day_IntervalType, 14, DateAdd(Month_IntervalType, 3, dtAdjustedStartDate)))
    arraySurveyDates(4, 1) = AdjustWeekendDate(DateAdd(Month_IntervalType, 4, dtAdjustedStartDate))
    arraySurveyDates(5, 1) = AdjustWeekendDate(DateAdd(Day_IntervalType, 14, DateAdd(Month_IntervalType, 4, dtAdjustedStartDate)))
    arraySurveyDates(6, 1) = AdjustWeekendDate(DateAdd(Month_IntervalType, 7, dtAdjustedStartDate))
    arraySurveyDates(7, 1) = AdjustWeekendDate(DateAdd(Month_IntervalType, 8, dtAdjustedStartDate))
    arraySurveyDates(8, 1) = AdjustWeekendDate(DateAdd(Day_IntervalType, 14, DateAdd(Month_IntervalType, 3, dtAdjustedStartDate)))
    arraySurveyDates(9, 1) = AdjustWeekendDate(DateAdd(Month_IntervalType, 9, dtAdjustedStartDate))
    arraySurveyDates(10, 1) = AdjustWeekendDate(DateAdd(Day_IntervalType, 14, DateAdd(Month_IntervalType, 4, dtAdjustedStartDate)))

    For i = 1 To 10

    If DateDiff(Day_IntervalType, arraySurveyDates(i, 1), Date) >= MIN_REMINDER_DAYS Then

    arraySurveyDates(i, 2) = STATUS_SET

    Else

    'Not enough time for the reminder, so set the date to null and checkbox flag to false
    arraySurveyDates(i, 1) = vbNull
    arraySurveyDates(i, 2) = STATUS_NOT_SET

    End If

    Next i

    End Sub
    [/VBA]

    I have changed the code for the 1st of the following month, as I could not follow what you were doing with the second DateAdd statement. Also, for the 9 month reminders it looked like you were adding too many months, so I changed that as well.

    TJ
    Oh dear, I need a beer

  3. #3
    VBAX Tutor jamescol's Avatar
    Joined
    May 2004
    Location
    Charlotte, NC
    Posts
    251
    Location
    TJ,
    Looks promising! Thanks for taking a look and putting together your sample. I'll give it a try and let you know how it works.

    Cheers,
    James
    "All that's necessary for evil to triumph is for good men to do nothing."

Posting Permissions

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