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]

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

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