Checking Records

[Zippyfrog]

Assign Random Variables Without Duplicates

I have a pretty tough VBA question, and I am hoping someone could point me in the right direction to fix my code. Right now I am attempting to create a generic scheduling program, and the setup I am using is a school scheduling program. The goal is to take teachers and assign the classes they are going to teach to periods of the school day. And the code works great except for one thing: the code runs through and puts a teacher teaching multiple classes during the same period.

What I have in my code is a period (1 through 8) is assigned randomly to a class/teacher, then the next record is handled and assigned a random period. What I want the code to do is compare a string value, composed of the teacher ID and period ID for any duplicates - if there are duplicates, this means that the teacher is being assigned multiple classes the same period. And when this occurs, I want the code to re-run and assign a new random period to that record until there are no duplicates.

Below is the code that I have. If I remove the portion that say "Experiemental Code", it will assign all classes, but there are duplicate periods assigned. I can also get it to loop, but I get stuck in an infinite loop on the third record. Any help fixing or providing me with suggestions for the "Experiemental Code" section would be great!

Set rst = db.OpenRecordset("tblTempMasterSchedule", dbOpenTable)
rst.MoveFirst
rst.Edit
rst![PeriodID] = Int((8 - 1 + 1) * Rnd() + 1)
rst.Update
rst.MoveNext
Do
rst.Edit
rst![PeriodID] = Int((8 - 1 + 1) * Rnd() + 1)
rst.Update
'==========================================================
'Experimental Code
'Needs to check to make sure TeacherID/PeriodID is unique
'i.e. a teacher can't be assigned 2 classes the same period
'during master schedule generation
'==========================================================


Dim strPeriodID As String
Dim strTeacherID As String
Dim strComplete As String


strPeriodID = rst![PeriodID]
strTeacherID = rst![TeacherID]
strComplete = strPeriodID & "," & strTeacherID

rst.MoveFirst
If rst![PeriodID] & "," & rst![TeacherID] = strComplete Then
Do
rst.Edit
rst![PeriodID] = Int((8 - 1 + 1) * Rnd() + 1)
Loop Until rst![PeriodID] & "," & rst![TeacherID] = Not strComplete
Else
rst.MoveNext
End If


'==========================================================
'End Experimental Code
'==========================================================

rst.MoveNext
Loop Until rst.EOF

rst.Close
Set rst = Nothing

 

[Banana]

I would want to open two recordset and compare one against another.

Here's a pseudocode that may get you started.

Dim rst As Recordset
Dim rst2 As Recordset
Dim bPass as Boolean
Dim varTest as Variant 'This is because I'm not 100% sure if it should be a integer or a string'

Set dbs = CurrentDb
Set rst = (MasterSchedule)
Set rst2 = (QueryOfTeachersAlreadyAssignedToPeriod)

rst.Movefirst

Do Until rst.EOF = True
      Do Until bPass=True
          varTest = Int((8 - 1 + 1) * Rnd() + 1)
          rst2.FindFirst "varTest"
          If rst2.NoMatch = True Then
              rst.Edit
              rst!Period= varTest
              bPass = True
              rst.Update
              rst.MoveNext
          Else
             bPass=False
          End If
       Loop
Loop

 

[Zippyfrog]

Thanks. I will try that and see what I come up with.

 

[Zippyfrog]

Ok, I am still running into trouble. Hopefully you can help me again. Here is a picture of my table - after the table is populated with the data (as it is in this picture), I want my code to check the last two columns - teacherID and periodID. My ultimate goal is that I want the program to check the combined value of the two columns and make sure there are no exact combinations of teacherID and periodID. And if there is a conflict, I want it to add another random period into PeriodID to make the TeacherID/PeriodID combination unique. (Notice how the program failed to check midway down where teacherID of 9 is teaching two separate classes during the Period that is tied to PeriodID of 7)

I tried using Banana's code and made some changes to reflect my database, but still it won't check out correctly. If someone could advise me on what else I could change to make it better, it would be greatly appreciated! See my updated code below:

Private Sub Command14_Click()
    Dim db As DAO.Database
    Dim tdf As DAO.TableDef
    Dim fld As DAO.Field
    Dim rst As DAO.Recordset
    Dim rst2 As DAO.Recordset
    Dim bpass As Boolean
    Dim varTest As Integer
    Dim strSQL As String
    Dim strTableName As String
    
    
    strSQL = "SELECT qryDynamicTeacherRequests.SchoolYearID, qryDynamicTeacherRequests.TermID, qryDynamicTeacherRequests.ClassID, qryDynamicTeacherRequests.RoomID, qryDynamicTeacherRequests.TeacherID " & _
             "INTO tblTempMasterSchedule " & _
             "FROM qryDynamicTeacherRequests;"
    DoCmd.SetWarnings False
    DoCmd.RunSQL strSQL
    DoCmd.SetWarnings True
    
    Set db = CurrentDb()
    Set tdf = db.TableDefs("tblTempMasterSchedule")
    Set fld = tdf.CreateField("PeriodID", dbDouble)
    
    tdf.Fields.Append fld

    Set rst = db.OpenRecordset("tblTempMasterSchedule", dbOpenTable)
    Set rst2 = db.OpenRecordset("tblMasterSchedule", dbOpenTable)
    
    rst.MoveFirst

    

       rst.Edit
            rst![PeriodID] = Int((8 - 1 + 1) * Rnd() + 1)
        rst.Update
        rst.MoveNext
    Do
           rst.Edit
           rst![PeriodID] = Int((8 - 1 + 1) * Rnd() + 1)
           rst.Update
         rst.MoveNext
    Loop Until rst.EOF
    rst.Close
    Set rst = Nothing

'Copy info into final Master Schedule Table
    Dim stDocName As String
    Dim stLinkCriteria As String

    DoCmd.SetWarnings False
    stDocName = "qryDynamicTeacherRequestsToMasterSchedule"
    DoCmd.OpenQuery stDocName
    DoCmd.SetWarnings True
    
        '==========================================================
        'Experimental Code
        'Needs to check to make sure TeacherID/PeriodID is unique
        'i.e. a teacher can't be assigned 2 classes the same period
        'during master schedule generation
        '==========================================================
rst2.MoveFirst


Do Until rst2.EOF = True
      Do Until bpass = True
          varTest = Val(Int((8 - 1 + 1) * Rnd() + 1))
          rst2.FindFirst (varTest)
          If rst2.NoMatch = True Then
              rst2.Edit
              rst2![PeriodID] = varTest
              bpass = True
              rst2.Update
              rst2.MoveNext
          Else
             bpass = False
          End If
       Loop
Loop

 

[Banana]

I think this may be the culprit:

rst2.FindFirst (varTest)

The fields to compare varTest against isn't enumerated, so I'm not sure what it is comparing against what. It should be something like:

rst2.FindFirst (PeriodID= " & varTest)

Let me know if that made the difference.

 

[Zippyfrog]

Thanks again for some feedback. I get a different error this time:

rst2.FindFirst (varTest)

That line I get an error saying "Operation is not supported for this type of object"

However, when I check the value that is stored in memory, it picked up the right number (whatever the periodID that is being compared) but the code stops at that point.

So I am not sure if your changed suggestion made a difference yet

 

[Banana]

You need to make sure you have your recordset as dynaset-

Do Until rst2.EOF = True
    TestPerson = !PersonID
    TestPeriod = !PeriodID
    Do Until bPass = True
    With rst2
        If bSearch = False Then
            With rst 3
               .FindFirst("PersonID = " & TestPerson & ", "TestPeriod = " & TestPeriod & ")
               .FindNext("PersonID = " & TestPerson & ", "TestPeriod = " & TestPeriod & ")
               If .NoMatch = True Then
                    bPass = True
                    bSearch = False
                Else
                    bPass = False
                    bSearch = True
               End If
            End With
        Else
            !PeriodID = varTest
            .Update
            .LastModified
            !PeriodID = TestPeriod
            With rst3
               FindFirst("PersonID = " & TestPerson & ", "TestPeriod = " & TestPeriod & ")
               FindNext("PersonID = " & TestPerson & ", "TestPeriod = " & TestPeriod & ")
               If .NoMatch = True Then
                  bPass = True
                  bSearch = False
               Else
                  bPass = False
                  bSearch = True
            End If
        End If
        If bPass = True Then .MoveNext
        End With
    Loop
Loop

Note that we use FindFirst then Findnext to make sure that we are indeed looking at a duplicate record. For those that has duplicate, we assign a new value then check it against the entire table in case it may duplicate a previous record that passed the test.

One suggestion- See if you can edit your thread title to say something more descriptive- perhaps "Assigning random variables without any duplicates" to get more people to read.

HTH.

Edit= After asking myself why I mentioned needing two recordset which you didn't use to compare, it hit me- If you are comparing a recordest against itself, and you are using FindFirst, you will be moving the pointer to wherever you found the record. While you can bookmark it, I would prefer to compare against another identical recordset, which can be updated. Therefore, for all Find lines, you need to enclose them into a "With rst3" block (as you seem to be using rst for something else unrelated to this) which is a query of just personid and periodid and add a line to update the rst3 to keep it current as you progress through rst2's record.

Edit #2 Modified the code to include the rst3 to check against.

 

[Zippyfrog]

Thanks once again for your help.

Three quick questions:
a. I declared varTest at the beginning, do I need to say at somepoint that varTest = Int((8 - 1 + 1) *

Rnd() + 1) like we did in the previous code?

b. Can you pick out what is wrong with the following syntax?
FindFirst("TestTeacher = " & TestTeacher & ", "TestPeriod = " & TestPeriod & ")
FindNext("TestTeacher = " & TestTeacher & ", "TestPeriod = " & TestPeriod & ")

c. Do I need to declare bSearch as Boolean?

those lines are in red in my code and when I compile I get a syntax error.


Below is my full updated code with all my recordsets being declared.

    Dim db As DAO.Database
    Dim tdf As DAO.TableDef
    Dim fld As DAO.Field
    Dim rst As DAO.Recordset
    Dim rst2 As DAO.Recordset
    Dim bpass As Boolean
    Dim varTest As Integer
    Dim strSQL As String
    Dim strTableName As String
    
    
    strSQL = "SELECT qryDynamicTeacherRequests.SchoolYearID, qryDynamicTeacherRequests.TermID, 

qryDynamicTeacherRequests.ClassID, qryDynamicTeacherRequests.RoomID, 

qryDynamicTeacherRequests.TeacherID " & _
             "INTO tblTempMasterSchedule " & _
             "FROM qryDynamicTeacherRequests;"
    DoCmd.SetWarnings False
    DoCmd.RunSQL strSQL
    DoCmd.SetWarnings True
    
    Set db = CurrentDb()
    Set tdf = db.TableDefs("tblTempMasterSchedule")
    Set fld = tdf.CreateField("PeriodID", dbDouble)
    
    tdf.Fields.Append fld

    Set rst = db.OpenRecordset("tblTempMasterSchedule", dbOpenTable)
    Set rst2 = db.OpenRecordset("qryDynamicTeacherRequestsToMasterSchedule", dbOpenDynamic)
    Set rst3 = db.OpenRecordset("tblMasterSchedule", dbOpenTable)
    
    rst.MoveFirst
        rst.Edit
        rst![PeriodID] = Int((8 - 1 + 1) * Rnd() + 1)
        rst.Update
        rst.MoveNext
    Do
           rst.Edit
           rst![PeriodID] = Int((8 - 1 + 1) * Rnd() + 1)
           rst.Update
         rst.MoveNext
    Loop Until rst.EOF
    rst.Close
    Set rst = Nothing

'Copy info into final Master Schedule Table
    Dim stDocName As String
    Dim stLinkCriteria As String

    DoCmd.SetWarnings False
    stDocName = "qryDynamicTeacherRequestsToMasterSchedule"
    DoCmd.OpenQuery stDocName
    DoCmd.SetWarnings True
    
        '==========================================================
        'Experimental Code
        'Needs to check to make sure TeacherID/PeriodID is unique
        'i.e. a teacher can't be assigned 2 classes the same period
        'during master schedule generation
        '==========================================================
Dim TestTeacher As String
Dim TestPeriod As String

Do Until rst2.EOF = True
    TestTeacher = rst2![TeacherID]
    TestPeriod = rst2![PeriodID]
    Do Until bpass = True
    With rst2
        If bSearch = False Then
            With rst3
               FindFirst("TestTeacher = " & TestTeacher & ", "TestPeriod = " & TestPeriod & ")
               FindNext("TestTeacher = " & TestTeacher & ", "TestPeriod = " & TestPeriod & ")
               If .NoMatch = True Then
                    bpass = True
                    bSearch = False
                Else
                    bpass = False
                    bSearch = True
               End If
            End With
        Else
            !PeriodID = varTest
            .Update
            .LastModified
            !PeriodID = TestPeriod
            With rst3
               FindFirst("TestTeacher = " & TestTeacher & ", "TestPeriod = " & TestPeriod & ")
               FindNext("TestTeacher = " & TestTeacher & ", "TestPeriod = " & TestPeriod & ")
               If .NoMatch = True Then
                  bpass = True
                  bSearch = False
               Else
                  bpass = False
                  bSearch = True
            End If
        End If
        If bpass = True Then .MoveNext
        End With
    Loop
Loop

 

[Banana]

WRT your questions about variables:

1) It is *strongly* recommended that you have this at top of every module you have:

Option Explicit

(If you are not sure what I mean by top, look for this line:

Option Compare Database

and insert the above just under that line.

Yes, all of your variables will need to be declared. Option Explicit will ensure that they are defined. So if there's need for another variable, you will need to add a dim.

Yes, you need to set the variables when you use it; as they have inital value of "empty" or "nothing", depending on what they are, but basically is the same; means nothing. So you will need to tell VBA editor that you want this variable to be X or something. This is usually done before you actually call the variable itself (In this case, you want to assign the randomizer to varTest before the loop starts since it won't change during the loops.)

It's helpful to remember that the computer does not have any common sense, and needs to be spoon-fed everything unlike humans who can make inferences from inadequate information.

Now for the criteria, I messed up- instead of

"TestTeacher = " & TestTeacher & "

, it should be

"TeacherID = " & TestTeacher & "

If you read the help menu on findfirst you will see it needs the left hand to refer to a field name. So if your table has a field named SomeField and you want to test it against SomeCriteria, the FindFirst need to be in this form:

FindFirst("SomeField = SomeCriteria")

.

HTH.

 

[Zippyfrog]

Ahhh, so close to getting it to work! As it runs, I get a compile error on the PeriodID portion of

FindFirst("TeacherID = " & TestTeacher & ", "PeriodID = " & TestPeriod & ")

If I take the statement so that it only compares TeacherID and write it as

FindFirst ("TeacherID = " & TestTeacher & "")

I get no compile error, the text is black and automatically fixes the alignment. However, when I have the second field in the criteria that is being compared, I get an compile error saying that it is looking for a list separator. Any ideas?

Edit: I changed the code to have an "AND" statement and it runs through without any syntax errors. Not sure if it is correct, but it runs without syntax errors.
Me.Recordset.FindFirst ("TeacherIDCompared = " & TestTeacher & "" And "PeriodIDCompared = " & TestPeriod & "")
Me.Recordset.FindNext ("TeacherIDCompared = " & TestTeacher & "" And "PeriodIDCompared = " & TestPeriod & "")

 

[Zippyfrog]

I am coming right along. A lot of changes with the code. Provided my previous post was a valid thing to do, my next error is a type mismatch error on the same lines:

Me.Recordset.FindFirst ("TeacherIDCompared = " & TestTeacher & "" And "PeriodIDCompared = " & TestPeriod & "")
Me.Recordset.FindNext ("TeacherIDCompared = " & TestTeacher & "" And "PeriodIDCompared = " & TestPeriod & "")

I have tried changing the type to String and Double, but that still produced a type mismatch error. Full code listed below. Do you see what I am doing wrong?

Private Sub Command14_Click()
    Dim db As DAO.Database
    Dim tdf As DAO.TableDef
    Dim fld As DAO.Field
    Dim rst As DAO.Recordset
    Dim rst2 As DAO.Recordset
    Dim rst3 As DAO.Recordset
    Dim bpass As Boolean
    Dim bsearch As Boolean
    Dim varTest As Integer
    Dim strSQL As String
    Dim strTableName As String
    
    varTest = Int((8 - 1 + 1) * Rnd() + 1)
    
    
    strSQL = "SELECT qryDynamicTeacherRequests.SchoolYearID, qryDynamicTeacherRequests.TermID, qryDynamicTeacherRequests.ClassID, qryDynamicTeacherRequests.RoomID, qryDynamicTeacherRequests.TeacherID " & _
             "INTO tblTempMasterSchedule " & _
             "FROM qryDynamicTeacherRequests;"
    DoCmd.SetWarnings False
    DoCmd.RunSQL strSQL
    DoCmd.SetWarnings True
    
    Set db = CurrentDb()
    Set tdf = db.TableDefs("tblTempMasterSchedule")
    Set fld = tdf.CreateField("PeriodID", dbDouble)
    
    tdf.Fields.Append fld

    Set rst = db.OpenRecordset("tblTempMasterSchedule", dbOpenTable)

    
    rst.MoveFirst
        rst.Edit
        rst![PeriodID] = Int((8 - 1 + 1) * Rnd() + 1)
        rst.Update
        rst.MoveNext
    Do
           rst.Edit
           rst![PeriodID] = Int((8 - 1 + 1) * Rnd() + 1)
           rst.Update
         rst.MoveNext
    Loop Until rst.EOF
    rst.Close
    Set rst = Nothing

'Copy info into final Master Schedule Table
    Dim stDocName As String
    Dim stLinkCriteria As String

    DoCmd.SetWarnings False
    stDocName = "qryDynamicTeacherRequestsToMasterSchedule"
    DoCmd.OpenQuery stDocName
    DoCmd.SetWarnings True
    
        '==========================================================
        'Checking Code
        'Needs to check to make sure TeacherID/PeriodID is unique
        'i.e. a teacher can't be assigned 2 classes the same period
        'during master schedule generation
        '==========================================================
Dim TestTeacher As Integer
Dim TestPeriod As Integer
Dim TeacherIDCompared As Integer
Dim PeriodIDCompared As Integer

Set rst2 = db.OpenRecordset("tblMasterSchedule", dbOpenTable)
Set rst3 = db.OpenRecordset("tblMasterSchedule", dbOpenTable)
    
Do Until rst2.EOF = True
    TestTeacher = rst2![TeacherID]
    TestPeriod = rst2![PeriodID]
    TeacherIDCompared = rst3![TeacherID]
    PeriodIDCompared = rst3![PeriodID]
    
    Do Until bpass = True
    With rst2
        If bsearch = False Then
            With rst3
               Me.Recordset.FindFirst ("TeacherIDCompared = " & TestTeacher & "" And "PeriodIDCompared = " & TestPeriod & "")
               Me.Recordset.FindNext ("TeacherIDCompared = " & TestTeacher & "" And "PeriodIDCompared = " & TestPeriod & "")
               If .NoMatch = True Then
                    bpass = True
                    bsearch = False
                Else
                    bpass = False
                    bsearch = True
               End If
            End With
        Else
            !PeriodID = varTest
            .Update
            !PeriodID = TestPeriod
            With rst3
               Me.Recordset.FindFirst ("TeacherIDCompared = " & TestTeacher & "" And "PeriodIDCompared = " & TestPeriod & "")
               Me.Recordset.FindNext ("TeacherIDCompared = " & TestTeacher & "" And "PeriodIDCompared = " & TestPeriod & "")
               If .NoMatch = True Then
                  bpass = True
                  bsearch = False
               Else
                  bpass = False
                  bsearch = True
               End If
             End With
        If bpass = True Then .MoveNext
        End If
    End With
   Loop
Loop
        '==========================================================
        'End Checking Code
        '==========================================================


End Sub

 

[Banana]

Two things:

You should have .LastModified right after .Update. This keeps the pointer at the record you just edited because after a .Update is issued, the pointer returns to the start of record.

Secondly, the type should match whatever you defined the TeacherID and PeriodID. If they are autonumber, they need to be a Long. Iff you are not sure, go back to the table where you have TeacherID and PersonID, and look at the type of the those fields.

 

[Zippyfrog]

I had some trouble with .LastModified right after .Update As soon as I ran my code, I got an "Invalid Use of Property" error, so I commented it out as I was trying to figure out my other error.

I went back and looked at the table, and both the teacherID and PeriodID are foreign keys to primary keys that are autonumbers, so I did change them to Long. I am still getting the type mismatch error though.

Interesting thing though, when I put my cursor over the variable in the code window

    TestTeacher = rst2![TeacherID]
    TestPeriod = rst2![PeriodID]
    TeacherIDCompared = rst3![TeacherID]
    PeriodIDCompared = rst3![PeriodID]

those variables are all defined, and all have values in them. However, when I put my cursor over the variables in these lines:

Me.Recordset.FindFirst ("TeacherIDCompared = " & TestTeacher & "" And "PeriodIDCompared = " & TestPeriod & "")
               Me.Recordset.FindNext ("TeacherIDCompared = " & TestTeacher & "" And "PeriodIDCompared = " & TestPeriod & "")

the variable is only defined for TestTeacher and TestPeriod. The same variables that appear at the dim declaration statement appear, but the TeacherIDCompared and PeriodIDCompared have no data in them. Any idea why that is? I think that is why I am having the type mismatch - there is no value defined for those two variables in the FindFirst section.

 

[Banana]

For .LastModified, that's probably because I don't know the proper syntax to call it; I looked in the help but it was vague. I suggest that you google it or look at MSDN documentation explaining how to use the LastModified property.

Just so you know, VBA doesn't always show all the values; if you did the same thing with a Dlookup() or something like that, it will read the values from criteria as it has been explictly defined.

Furthermore, it is expected that there will be no data in the variable at dim statement; after all it hasn't been looked up yet.

To get the value from those statement use this code-

Debug.Print YourVariableHere

Mind you, make sure to place it both before the Find lines and after so you can see how the value changes because as I said before, the pointer always will start at the first record and will move *only* when told to do so.

If you continue to get stuck, you could scrap your db down to relevant forms and upload it for others to take a look at.

 

[Zippyfrog]

Thanks once again for your time and knowledge. I took your advice and compacted the database and uploaded it so others could see if they could find my error. The error is on frmGenerateMasterSchedule when you click the button that says "Generate Master Schedule off of Dynamic Classes"

I spent a bunch of time this morning trying to figure out why there is a type mismatch, but am still not sure why. The variables are all being stored properly, and to me the comparison should work...

 

[Karma]

My suggestion would be to remove the key from the field RoomID in tblMasterSchedule.

Currently with roomID as part of the key you can have

Mrs Smith Period 1 room1
Mrs Smith period 1 room2 etc

but not

Mrs Smith Period 1 room1
Mrs Smith period 1 room1

If you remove that part of the key you'll only be able to add a teacher once to a period, the room then takes care of itself.

Mrs Smith period 1 room 1 will be have to be a unique entry.

You couldn't have

Mrs Smith period 1 room 2 as well as name and period must be unique.

Then when you try to add the data to the table you'll get a duplicates error 3022 which you can handle.

HTH

K

 

[Zippyfrog]

Thanks. I did remove that field for now. But I don't think that is going to help my "Type mismatch" error that I am consistently receiving... Any other ideas about why this might be a type mismatch?

 

[Banana]

Got type mismatch fixed.

You cannot have two strings being compared. Not only that they'd never change (e.g. you'd be comparing the same thing again and again), but also the FindFirst must have a fieldname, not a string referring to the fieldname, so syntax should be

FindFirst ( !TeacherID = " & TestTeacher & " And !PeriodID = " & TestPeriod &)

Also, in With block you used:

With rst3
   Me.recordset!PeriodID=
   .....
   End With

This only confuses VBA into thinking you were referring to the form's recordset which may be something entirely different. There is a reason for using a With block. Whenever something is within a With ... you no longer need to refer to whichever you are talking. E.g. Instead of writing

Forms!MyForm.Form!MySubForm.Form!MyControl.Property = X
Forms!MyForm.Form!MySubForm.Form!MyControl2.Property = Y
Forms!MyForm.Form!MySubForm.Form!MyControl3.Property = Z
Forms!MyForm.Form!MySubForm.Form.Recordset = A

which can get old real fast, I'd use With like this:

With Forms!MyForm.Form!MySubForm.Form
    !MyControl.Property = X
    !MyControl2.Property = Y
    !MyControl3.Property = Z
    .Recordset = A
End With

Also, you should be careful and be sure to understand what you are trying to do. Here, you wrote this:

!PeriodID= varTest
!PeriodID= TestPeriod

This has the effect of resetting the PeriodID back to the number that it failed the bpass the first time because TestPeriod still holds the same number (the loop hasn't been passed for it to be reset. varTest also has the same effect as it doesn't randomize a new number; rather it holds a number that was randomized once. That was my error because I seem to think I was one who told you to use a varTest. You only really need this:

!PeriodID = Int((8 - 1 + 1) * Rnd() + 1)
TestPeriod = !PeriodID

Note the difference in the second line. It is the left hand that always get changed whereas the right variable determines how left hand will change.

HTH.

BTW, I got code to work and was looping when my computer crashed and lost all my edits so I'll have to try again when I have free time. Sorry for the delay.

 

[Zippyfrog]

Thanks for the reply. I noticed in the FindNext code you had the field. Does this mean that I do not need my TeacherIDCompared and PeriodIDCompared fields at all?

 

[Banana]

Okay, I tackled it again- It does seems that FindFirst & FindNext isn't reliable; duplicates are still generated. Can't imagine why it'd do that, even though every record has been checked and none were skipped.

So I went another route. If you create a new query by clicking on "New" button on Database window (as opposed to clicking on "Create a new query with Wizard" in the menu list), you can choose Find Duplicate Wizard which I used to create a new query, "qtrDuplicateEliminator", which returns all duplicates with the counts.

I modified the code so it'd loop through counts of duplicate record for each duplicate teacher/period ID adn editing, then requerying the query until query returns nothing.

Set rst2 = db.OpenRecordset("tblMasterSchedule", dbOpenDynaset)
Set rst3 = db.OpenRecordset("qtrDuplicateEliminator", dbOpenDynaset)

Do Until rst3.RecordCount = 0
    rst3.MoveFirst
    Do Until rst3.EOF = True
        With rst3
            DupeTeacher = !DupeTeacherID
            DupePeriod = !DupePeriodID
        End With
        
        For i = 1 To rst3!DupeCount
            With rst2
                .FindFirst ("[PeriodID] = " & DupePeriod & " And [TeacherID] = " & DupeTeacher & "")
                .Edit
                !PeriodID = Int((8 - 1 + 1) * Rnd() + 1)
                .Update
            End With
        Next i
        
        rst3.MoveNext
    Loop
    rst3.Requery
Loop

This does work in eliminating all duplicates. However, I note that you have a button to create a schedule based on teacher's requests. If you were planning on building a schedule based on teacher's requests then randomizing where there is a conflict, you should be aware the solution I post above will potentially edit the records explicitly requested by teachers.

If that is what you want, take a look at "qtrDuplicateRecord"- it will give you clue on how to create a loop that goes through the Master Schedule without editing the records that were requested by teachers. This is something you will want to do on yourself. Oh, and be sure to read up on what makes queries updatable and not as the qtrDuplicateRecord isn't updatable so you can't edit in it directly.

That said, you should realize that foreign key doesn't have to be selected as a primary key in table. You had several fields set as compound key, which would only complicate things. Rather, you only need to have a autonumber as a key and the foreign keys will be defined via the relationship. I've already edited the table for you. Take look at it. You can see that having a autonumber makes it much easier for one to edit a specific record. That is important if you will want to hold onto teacher's requests and edit only those where there is a conflicts.

Here's your database back.