Checking Lunches Against Conditions

Lunch Pairings Classes
Populating Lunch Pairings

My method for creating proposed lunches is to add three random contacts to make a lunch, then see if that lunch meets the conditions. If it does, I add it to the lunches collection class. If not, I try another combination. The portion of the FillMonth method that does this looks like:

If Not clsLunch.IsRepeat Then
Me.Add clsLunch
bAdded = True
lCnt = lCnt + 1
End If

I’ve put all my previously mentioned conditions into one property called IsRepeat.

Public Property Get IsRepeat() As Boolean

Dim clsLunch As CLunch
Dim bReturn As Boolean
Dim i As Long

For i = gclsLunches.Count To 1 Step -1
Set clsLunch = gclsLunches.Lunch(i)

If clsLunch.LunchDate = Me.LunchDate Then
If clsLunch.AttendeeMatch(Me, 1) Then
bReturn = True
Exit For
End If
End If

If clsLunch.IsWithin(Me.LunchDate, 2) Then
If clsLunch.AttendeeMatch(Me, 2) Then
bReturn = True
Exit For
End If
End If

If clsLunch.IsWithin(Me.LunchDate, 10) Then
If clsLunch.AttendeeMatch(Me, 3) Then
bReturn = True
Exit For
End If
End If
Next i

IsRepeat = bReturn

End Property

I loop through all the existing lunches, from both past months and those from the month I’m working on. In the first test, I check to see if the lunch is in the same month as the proposed lunch. Then I check if any of the attendees match via the AttendeeMatch property.

Public Property Get AttendeeMatch(clsLunch As CLunch, lMatchMax As Long) As Boolean

Dim vaMe As Variant
Dim vaLunch As Variant
Dim i As Long, j As Long
Dim lCnt As Long
Dim clsMeAtt As CContact
Dim clsLunchAtt As CContact

vaMe = Split(Me.AttendeeList, "|")
vaLunch = Split(clsLunch.AttendeeList, "|")

For i = LBound(vaMe) To UBound(vaMe)
For j = LBound(vaLunch) To UBound(vaLunch)
If vaMe(i) = vaLunch(j) Then
lCnt = lCnt + 1
End If
Next j
Next i

AttendeeMatch = lCnt >= lMatchMax

End Property

This property is bit weird. There are some unused variables in there, for one. In a later post, I’ll talk about the performance problems I had and how I tried to reduce execution time. The AttendeeList property returns a string of contact names, pipe delimited, and sorted by first names. Now that I look at it, I don’t think those names need to be sorted, but I use that property later where they do, so it’s there.

I’m checking my condition that a contact only have one lunch per month. I passed in a “1” to lMatchMax so that if there was even one match, the lunch gets booted.

For my next condition, I test to make sure that no two contacts are in a lunch in the last two months. That starts by testing whether the lunch is within the last two months via the IsWithin property. Terrible name, I know.

Public Property Get IsWithin(dtLunch As Date, lMonths As Long) As Boolean

IsWithin = dtLunch > DateSerial(Year(Me.LunchDate), Month(Me.LunchDate) - lMonths, 0)

End Property

If it passes this test, I call AttendeeMatch again, but this time with a lMatchMax of 2.

The final condition is that no three contacts are in the same group in the last ten months. It’s the same as the previous condition except that IsWithin gets passed a 10 and AttendeeMatch gets passed a 3.

Finally, I write the lunches by month to a range. Back in the main calling procedure,

For lMonth = lFIRST To lLAST
vaWrite = gclsLunches.LunchesByMonth(lMonth).RangeOutput
wshLunch.Cells(wshLunch.Rows.Count, 1).End(xlUp).Offset(1, 0).Resize(UBound(vaWrite, 1), UBound(vaWrite, 2)).Value = vaWrite
Next lMonth

The RangeOutput property returns a two-dimensional array

Public Property Get RangeOutput() As Variant

Dim aReturn() As String
Dim clsLunch As CLunch
Dim lCnt As Long
Dim i As Long
Dim lAttCnt As Long

ReDim aReturn(1 To Me.Count, 1 To 5)

For Each clsLunch In Me
lCnt = lCnt + 1
lAttCnt = 0
aReturn(lCnt, 1) = clsLunch.LunchMonth
aReturn(lCnt, 2) = clsLunch.Attendees.Contact(clsLunch.Facilitator).FullName
aReturn(lCnt, 5) = clsLunch.AttendeeList
For i = 1 To clsLunch.Attendees.Count
If i <> clsLunch.Facilitator Then
lAttCnt = lAttCnt + 1
aReturn(lCnt, 2 + lAttCnt) = clsLunch.Attendees(i).FullName
End If
Next i
Next clsLunch

RangeOutput = aReturn

End Property

The Facilitator is listed first, then the other two attendees. I also spit out the sorted AttendeeList so I can do a countif and make sure I didn’t screw anything up. And I screwed up plenty.

Next up, I’ll discuss some of the performance problems I had and how I solved them.


Posting code? Use <pre> tags for VBA and <code> tags for inline.

Leave a Reply

Your email address will not be published.