Access VBA: Eliminating FindFirst Looping Duplication - ms-access

Question

i have 4 listboxes named listMachine, listMachineSystem,listMachineSubSystem and listcompoenents. The user selects the items the from the list boxes as he wishes and the tables are populated along with the ID from the previuos table to the new table since all the listboxes are connected hierarchially. The problem is that in the tblcomponents the seleted items get popileuted in a loop over and over agao an i dont how to stop this . I have attahced the code below . Can anyone help me out on this.
ID = DMax("[MAchine ID]", "tblmachine")
Dim sMachineSubsystem As String, varSelectedID11 As Variant
Dim vMaxMachineSubsystemID As Variant
Set db = CurrentDb()
Set rs = db.OpenRecordset("tblMachineSystem", dbOpenDynaset, dbAppendOnly)
Set rs1 = db.OpenRecordset("tblMachineSubSystem", dbOpenDynaset, dbAppendOnly)
Set rs2 = db.OpenRecordset("tblComponents", dbOpenDynaset, dbAppendOnly)
For n = 0 To Me.listMachineSystem.ListCount - 1
If Me.listMachineSystem.Selected(n) Then
rs.AddNew
rs!MachineSystem = Me.listMachineSystem.Column(0, n)
rs![MAchine ID] = ID
rs!MO_TAG = Me.listMachineSystem.Column(3, n)
rs!MachineSystem_Details = Me.listMachineSystem.Column(4, n)
rs.Update
End If
Next n
For i = 0 To Me.listMachineSubSystem.ListCount - 1
If Me.listMachineSubSystem.Selected(i) Then
rs.FindFirst "[Machine ID]=" & ID & " AND [MachineSystem]= '" &
DLookup ("[MachineSystem]", "tblMachineSystem",
"[Machine System ID]=" & Me.listMachineSubSystem.Column(2, i)) & "'"
rs1.AddNew
rs1![MachineSubsystem] = Me.listMachineSubSystem.Column(0, i)
rs1![Machine Sytem ID] = rs![Machine System ID]
rs1![MO_TAG] = Me.listMachineSubSystem.Column(3, i)
rs1![MachineSubSystem_Details] = Me.listMachineSubSystem.Column(4, i)
rs1.Update
'add selected value(s) from listComponents to tblComponents
For l = 0 To Me.listComponents.ListCount - 1
If Me.listComponents.Selected(l) Then
varSelectedID2 = Me.listComponents.Column(2, l)
sMachineSubsystem = DLookup("[MachineSubsystem]", "tblMachineSubSystem",
"[Machine Subsystem ID]=" & varSelectedID2)
vMaxMachineSubsystemID = DMax("[Machine System ID]", "tblMachineSystem",
"[Machine ID]=" & ID & " AND [MachineSystem]= '" &
DLookup("[MachineSystem]", "tblMachineSystem", "[Machine System ID]="
& rs![Machine System ID]) & "'")
rs1.FindFirst "[Machine Sytem ID]=" & vMaxMachineSubsystemID & "
AND [MachineSubsystem]= '" & sMachineSubsystem & "'"
If rs1.NoMatch Then
MsgBox "no records found"
Else
Do While Not rs1.NoMatch
MsgBox "I found it!!!"
rs2.AddNew
rs2![Components] = Me.listComponents.Column(0, l)
rs2![Machine Subsystem ID] = rs1![Machine Subsystem ID]
rs2![MO_TAG] = Me.listComponents.Column(3, l)
rs2![Components_Detail] = Me.listComponents.Column(4, l)
rs2.Update
rs1.FindNext "[Machine Sytem ID]=" & vMaxMachineSubsystemID & "
AND [MachineSubsystem]= '" & sMachineSubsystem & "'"
Loop
End If
End If
Next l
End If
Next i