Sub FillCardsSTD(lngCardCount As Long, Optional blnFreeSpace As Boolean = False)
On Error GoTo Err_FillCards_Click
Dim myDB As Database
Dim rsCards As Recordset
Dim intCellCounter As Integer
Dim lngCardCounter As Long
Dim fldCurrentField As Field
Set myDB = CurrentDb()
Set rsCards = myDB.OpenRecordset("tblCards", dbOpenDynaset)
'---Main
'clear cards table
DoCmd.SetWarnings False
DoCmd.OpenQuery "qrdClearCards"
DoCmd.SetWarnings True
'Set up outer loop to iterate the once for each card specified in txtNumCards
For lngCardCounter = 1 To lngCardCount
rsCards.AddNew
rsCards!cardno = lngCardCounter
'setup inner loop to iterate across the current record and fill with selected values
Set fldCurrentField = rsCards.Fields(0) 'cell 0 = cardno and is the card sequence number
fldCurrentField.Value = lngCardCounter
For intCellCounter = 1 To 25 'the rest of the cells
Set fldCurrentField = rsCards.Fields(intCellCounter)
Select Case intCellCounter
Case 1, 6, 11, 16, 21 'the B column
fldCurrentField.Value = FindRandom_TSB("", "tblB", "CellContents")
Case 2, 7, 12, 17, 22 'the I column
fldCurrentField.Value = FindRandom_TSB("", "tblI", "CellContents")
Case 3, 8, 13, 18, 23 'the N column
If Not intCellCounter = 13 Then
fldCurrentField.Value = FindRandom_TSB("", "tblN", "CellContents")
ElseIf blnFreeSpace Then
fldCurrentField.Value = "AtivoAccess"
Else
fldCurrentField.Value = FindRandom_TSB("", "tblN", "CellContents")
End If
Case 4, 9, 14, 19, 24 'the G column
fldCurrentField.Value = FindRandom_TSB("", "tblG", "CellContents")
Case 5, 10, 15, 20, 25 'the O column
fldCurrentField.Value = FindRandom_TSB("", "tblO", "CellContents")
Case Else
End Select
Next 'Card field
'save/commit new record before moving to next row
rsCards.Update
'clear used flags in Cell Contents table
DoCmd.SetWarnings False
DoCmd.OpenQuery "qruSetUsedtoFalseB"
DoCmd.OpenQuery "qruSetUsedtoFalseI"
DoCmd.OpenQuery "qruSetUsedtoFalseN"
DoCmd.OpenQuery "qruSetUsedtoFalseG"
DoCmd.OpenQuery "qruSetUsedtoFalseO"
DoCmd.SetWarnings True
Next 'Card record
'---Clean up
Set rsCards = Nothing
Set myDB = Nothing
Exit_FillCards_Click:
Exit Sub
Err_FillCards_Click:
MsgBox Err.Description
Resume Exit_FillCards_Click
End Sub