Yesterday I set up Contact objects and Lunch objects. Now I want to create new Lunch objects that meet the conditions that I defined. From my main LunchTrios procedure:
For lMonth = lFIRST To lLAST
gclsLunches.FillMonth lMonth
Next lMonth
Ah, the brevity that class modules provide is a beautiful thing. I need FillMonth to:
- Get a list of active contacts
- Create a lunch with three of those contacts
- See if that lunch meets my conditions
- Keep the lunch if it passes, try another combination if it doesn’t
Public Sub FillMonth(lMonth As Long)
Dim clsLunch As CLunch
Dim dtLunch As Date
Dim i As Long, j As Long, k As Long
Dim bAdded As Boolean
Dim lCnt As Long
Dim clsActive As CContacts
Set clsActive = gclsContacts.Active
dtLunch = DateSerial(Year(Date), lMonth + 1, 0)
For i = 1 To clsActive.Count
bAdded = False
For j = 1 To clsActive.Count
If i <> j Then
For k = 1 To clsActive.Count
If i <> k And j <> k Then
Set clsLunch = New CLunch
clsLunch.LunchDate = dtLunch
clsLunch.Attendees.Add clsActive(i)
clsLunch.Attendees.Add clsActive(j)
clsLunch.Attendees.Add clsActive(k)
clsLunch.Facilitator = CLng((Rnd * (clsLunch.Attendees.Count - 1)) + 1)
If Not clsLunch.IsRepeat Then
Me.Add clsLunch
bAdded = True
lCnt = lCnt + 1
End If
End If
If bAdded Then Exit For
Next k
End If
If bAdded Then Exit For
Next j
If lCnt >= clsActive.Count \ 3 Then Exit For
Next i
End Sub
My first step is to get a list of active participants. I create a new instance of CContacts and store it in the variable called clsActive. Then I create a Property of the CContacts class to return an instance only containing active contacts. My main list of contacts is sorted by first name. I also have 29 active contacts, so two people every month won’t have a lunch. If I keep my contacts sorted, people like Wyatt James are always going to be left out because of his first name. I will have filled up my lunches by the time I get down to him. I need to test lunches in a somewhat random order so that the two people who get left out aren’t the same every month. To do this, I sort clsActive randomly. But I don’t really like sorting right after I populate a class. I have to loop through the contacts to populate the class, then again to sort it. It just seems wasteful. So I do it all in one fell swoop.
Public Property Get Active() As CContacts
Dim clsReturn As CContacts
Dim clsContact As CContact
Dim lRand As Long
Set clsReturn = New CContacts
For Each clsContact In Me
If clsContact.Active Then
lRand = CLng((Rnd * clsReturn.Count) + 1)
If clsReturn.Count = 0 Or lRand > clsReturn.Count Then
clsReturn.Add clsContact
Else
clsReturn.Add clsContact, lRand
End If
End If
Next clsContact
Set Active = clsReturn
End Property
As I added qualified contacts to the collection class, I insert the new contact before a random existing contact. This has the effect of giving me a randomly sorted list of contacts in clsActive.
Now that I have my list of active contacts, I loop through them three times creating a proposed lunch. I check if that lunch meets my conditions with IsRepeat and if so, add it to my Lunches collection class. I have a lot of code in there to skip out of the For loop when it’s found a match because looping takes forever. I also skip out when I have enough lunches for the month.
Next up, I’ll go through the IsRepeat property that checks to see if a lunch meets the conditions.
Posting code? Use <pre> tags for VBA and <code> tags for inline.