Junction Table Growing

[dwAccessUser32]

I have noticed that I now have a very strange problem with my junction table. Sarting with no records after implementing the code and running it I know have a junction table with over 100,000 records.

There has to be something in the loop that is causing this. Do you see anything that would be causing it? Did I implement the code incorrectly? Any ideas? For example, when I look in tjxPersonPersonType I get piles of records like this:

PersonPersonTypeID PersonTypeID PersonID
53023 1 73
53024 1 73
53025 1 73
53026 1 73
53027 1 73
53028 1 73
53029 1 73
53030 1 73
53031 1 73
53032 1 73
53033 1 73
53034 1 73
53035 1 73


It goes on for hundreds if not thousands of times. I can't figure out what is causing this strange behaviour. Do you have any idea?

Thanks

PS

The code that I am using is shown below:

Option Compare Database
Option Explicit
Private Sub Form_Current()


'Private Sub Form_Current()
Dim x As Integer
Dim rs As DAO.Recordset
Dim db As DAO.Database
Dim strSQL As String

'clear listbox

For x = 0 To Me.List131.ListCount - 1
Me.List131.Selected(x) = False
Next x

If Not Me.NewRecord Then


'this sql finds all person types selected for the currently displayed PersonID
strSQL = "SELECT tjxPersonPersonType.PersonID, tjxPersonPersonType.PersonTypeID FROM tjxPersonPersonType "
strSQL = strSQL & "WHERE tjxPersonPersonType.PersonID=" & Me.PersonID & ";"


Set db = CurrentDb
Set rs = db.OpenRecordset(strSQL)

With rs
'check if there are any person types selected
If Not .EOF And Not .BOF Then
'if so, move to the first one
.MoveFirst
'and loop until you've checked all the person types selected for this person
Do While Not .EOF
'loop through the listbox to find the selected state
For x = 0 To Me.List131.ListCount - 1
If Me.List131.ItemData(x) = CStr(!PersonTypeID) Then
''select' the person type
Me.List131.Selected(x) = True
'exit the For-Next loop to save time
Exit For
End If
Next x
'move to the next selected person type for this person
.MoveNext
Loop
End If
End With

'clean up everything
rs.Close
db.Close

Set rs = Nothing
Set db = Nothing
End If
End Sub

Private Sub List131_AfterUpdate()
On Error GoTo Err_List131
Dim x As Integer
Dim strSQL As String

'loop through the listbox and...
For x = 0 To Me.List131.ListCount - 1
If Me.List131.Selected(x) Then
'add the state if this state is selected or...
strSQL = "INSERT INTO tjxPersonPersonType ( PersonTypeID, PersonID ) SELECT tjxPersonPersonType."
strSQL = strSQL & "PersonTypeID, " & Me.PersonID & " AS Expr2 FROM tjxPersonPersonType "
strSQL = strSQL & "WHERE tjxPersonPersonType.PersonTypeID=" & Me.List131.ItemData(x)


'Debug.Print strSQL

Else
'delete the state if it's not
strSQL = "DELETE tjxPersonPersonType.*, tjxPersonPersonType.PersonID, tjxPersonPersonType "
strSQL = strSQL & ".PersonTypeID FROM tjxPersonPersonType WHERE tjxPersonPersonType.PersonID"
strSQL = strSQL & "=" & Me.PersonID & " AND tjxPersonPersonType.PersonTypeID="
strSQL = strSQL & Me.List131.ItemData(x) & ";"
'Debug.Print strSQL

End If

'execute the sql statement that was just created
CurrentDb.Execute strSQL, dbFailOnError
Next x

Exit_List131:
Exit Sub

Err_List131:
'Error 3022 means the user tried to add the same person type twice
'just ignore it if it happens
If Err.Number = 3022 Then
Resume Next
Else
'display any other errors
MsgBox Err.Number & " - " & Err.Description
Resume Exit_List131
End If
End Sub

 

[easyit]

Have u tried debugging and stepping through your code?

EasyIT

"Do you think that’s air you're breathing?

 

[dwAccessUser32]

Yes, and I don't see what the problem is. I actually have spent a great deal of time trying to figure out what is wrong, but haven't been successful.