Submitchanges after a loop - only last record saved

The following code works, but it only saves the last record in the loop, and I can't figure out why. I think the Submitchanges() is in the right place, at the end of the loop. Can someone please show me what's wrong? Thanks.

Sub POPULATE_CHAIN()

    Dim newChain As New CHAIN
    Dim dpSTRIKE As Integer

    'get list of Options Contracts
    Dim lstOPT = From Z In DATA.OPTIONs, X In DATA.UDLies
                 Where X.UDLY_SYM = Z.UDLY_SYM
                 Select Z.CONTRACT, Z.STRIKE_GAP, X.UDLY_LAST

    Dim dctOPT = lstOPT.ToDictionary(Function(Z) Z.CONTRACT)

    For Each key In dctOPT.Keys

        For COUNT = 1 To 5
            dpSTRIKE = 1850 + 5 * COUNT
            Dim lkup = From Z In DATA.CHAINs
                       Select Z
            Dim RCD_EXISTS As Boolean = lkup.Any(Function(Z) Z.CONTRACT = dctOPT(key).CONTRACT And Z.P_C = "C" And Z.STRIKE = dpSTRIKE)

            If RCD_EXISTS = False Then
                newChain.CONTRACT = dctOPT(key).CONTRACT
                newChain.P_C = "C"
                newChain.STRIKE = dpSTRIKE
                DATA.CHAINs.InsertOnSubmit(newChain)
            Else
                newChain.CONTRACT = dctOPT(key).CONTRACT
                newChain.P_C = "C"
                newChain.STRIKE = dpSTRIKE
            End If

        Next
    Next
    DATA.SubmitChanges()
End Sub

Dim newChain As New CHAIN

should be inside Fore Each, exactly inside second for. Since it is declared outside the loop, it will be detached from table and attached again to table. So it will be inserted only in last row.