Code Not Incrementing Through Rows

[reberryjr]

I have the code below, where I'm trying to increment through column F on 1 worksheet, and compare some values against another worksheet. I'm getting one result to copy over to the destination sheet, but there should be 175. Thoughts on where I've gone wrong?

Private Sub cmd_R_ImpMRData_Click()

Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False
Dim t, s As Workbook
Dim i, j As Long
Dim Rng1, Rng2 As Range
Dim tCD, sMR As Worksheet
Dim fp As String

Set tCD = ThisWorkbook.Sheets("CoreData")
tCDLR1 = tCD.Range("J" & Rows.Count).End(xlUp).Row
tCDLR = tCD.Range("A" & Rows.Count).End(xlUp).Row
Set FilePicker = Application.FileDialog(msoFileDialogFilePicker)
'Allows User to select the folder that contains the files being ingested.
With FilePicker
    .Title = "Select the Target Workbook"
    .AllowMultiSelect = False
    If .Show <> -1 Then GoTo NextCode
    fp = .SelectedItems(1)
End With
NextCode:
    fp = fp
    'If no file is chosen, resets the Excel defaults.
    If fp = "" Then GoTo ResetSettings
'Do While fp <> ""
    Set s = Workbooks.Open(Filename:=fp)
    Set sMR = s.Worksheets("MasterRecon")
    
    If sMR.FilterMode = True Then
        sMR.ShowAllData
    Else
    End If
    
    wsMRILR = sMR.Range("B" & Rows.Count).End(xlUp).Row
    wsIPLR = sMR.Range("E" & Rows.Count).End(xlUp).Row
    wsIELR = sMR.Range("L" & Rows.Count).End(xlUp).Row
    
    DoEvents
    
    'Copies the BAC and Seller loan numbers from the Intake sheet & pastes them onto the tracker.
    sMR.Range("B6:C" & wsMRILR).Copy
        tCD.Range("J" & tCDLR + 1).PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False
    
    'Populates the Today formula.
    With tCD.Range("A" & tCDLR1 + 1, tCD.Range("J" & Rows.Count).End(xlUp).Offset(, -9))
        .Value = "=Today()"
    End With
    
    'Populates the new range with the Type from the Source Sheet.
    With tCD.Range("B" & tCDLR1 + 1, tCD.Range("J" & Rows.Count).End(xlUp).Offset(, -8))
        .Value = sMR.Range("A2")
    End With
    
    'Populates the new range with the BUSPAR number from the Source Sheet.
    With tCD.Range("C" & tCDLR1 + 1, tCD.Range("J" & Rows.Count).End(xlUp).Offset(, -7))
        .Value = sMR.Range("B2")
    End With
    'Populates the new range with a formula to determine the Deal Number.
    With tCD.Range("D" & tCDLR1 + 1, tCD.Range("J" & Rows.Count).End(xlUp).Offset(, -6))
        .Value = "=IF(RC[-2] = ""Reboard"",""R"" & RC[-1],IF(RC[-2]=""Acquisition"",""B"" & RC[-1]))"
    End With
    
    'Populates the new range with the BUSPAR number from the Source Sheet.
    With tCD.Range("E" & tCDLR1 + 1, tCD.Range("J" & Rows.Count).End(xlUp).Offset(, -5))
        .Value = sMR.Range("D2")
    End With
    'Populates the new range with the Transfer Date from the Source Sheet.
    With tCD.Range("F" & tCDLR1 + 1, tCD.Range("J" & Rows.Count).End(xlUp).Offset(, -4))
        .Value = sMR.Range("E2")
    End With
    
    'Populates the new range with a formula to calculate the number of days until the Transfer Date.
    With tCD.Range("G" & tCDLR1 + 1, tCD.Range("J" & Rows.Count).End(xlUp).Offset(, -3))
        .Value = "=RC[-1]-RC[-6]"
    End With
    
    'Populates the new range with the Go Live Date from the Source Sheet.
    With tCD.Range("H" & tCDLR1 + 1, tCD.Range("J" & Rows.Count).End(xlUp).Offset(, -2))
        .Value = sMR.Range("F2")
    End With
    
    'Populates the new range with a formula to calculate the number of days until the Go Live Date.
    With tCD.Range("I" & tCDLR1 + 1, tCD.Range("J" & Rows.Count).End(xlUp).Offset(, -1))
        .Value = "=RC[-1]-RC[-8]"
    End With
    
    'Populates the Master Recon column with Y.
    With tCD.Range("BY" & tCDLR1 + 1, tCD.Range("J" & Rows.Count).End(xlUp).Offset(, 67))
        .Value = "Y"
    End With
    
tCDLR2 = tCD.Range("K" & Rows.Count).End(xlUp).Row
wsIPLR2 = sMR.Range("F" & Rows.Count).End(xlUp).Row

For i = 1 To tCDLR2
    Set Rng1 = tCD.Range("K" & i)
    
    For j = 1 To wsIPLR2
        Set Rng2 = sMR.Range("F" & j)
        
        If StrComp(CStr(Rng1.Value), CStr(Rng2.Value), vbTextCompare) = 0 Then
            If Rng1.Offset(, -7).Value = Rng2.Offset(-4, -3) Then
                tCD.Range("L" & i).Value = sMR.Range("G" & j).Value
                tCD.Range("CF" & i).Value = sMR.Range("H" & j).Value
                tCD.Range("CH" & i).Value = sMR.Range("I" & j).Value
                tCD.Range("CJ" & i).Value = sMR.Range("J" & j).Value
            End If
        End If
    Next j
Next i
Set Rng1 = Nothing
Set Rng2 = Nothing


ResetSettings:
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True
End Sub

 

[StephenCrump]

'I'm not totally clear where you're expecting the multiple matches ...
'... but based on these nested loops ..
For i = 1 To tCDLR2
    Set Rng1 = tCD.Range("K" & i)
    For j = 1 To wsIPLR2
        Set Rng2 = sMR.Range("F" & j)
        If StrComp(CStr(Rng1.Value), CStr(Rng2.Value), vbTextCompare) = 0 Then
            If Rng1.Offset(, -7).Value = Rng2.Offset(-4, -3) Then
                ' ... then for any given i value, if you get multiple matches inside this j loop
                ' ... then you will be [U]overwriting[/U] the i-th row in these next lines
                tCD.Range("L" & i).Value = sMR.Range("G" & j).Value
                tCD.Range("CF" & i).Value = sMR.Range("H" & j).Value
                tCD.Range("CH" & i).Value = sMR.Range("I" & j).Value
                tCD.Range("CJ" & i).Value = sMR.Range("J" & j).Value
            End If
        End If
    Next j
Next i

If this is the problem, perhaps you could keep a separate counter for the output row, and increment by 1 on each match?