Looping vba code until all relevant data ends?

[Indominus]

Hello. I have this VBA code that identifies route codes in one sheet in a workbook (pickorder). Then in another workbook (CX) it identifies those same route codes and gets the value (times) in 1 row below and pastes it into column A in the first workbook (pickorder). The code works really well. However, I just noticed that the CX sheet sometimes has a certain route code twice. The second one is at the very bottom where all the data is irrelevant. When this happens it pastes the second value in it finds. And the offset value it gets is not a time at all. I do not want it to find the same route twice just once. For instance, if TX51 is in pickorder. Search the data in CX sheet until it finds it, get the value, which is 1 row below it and paste it into pickorder. If TX51 is in the CX file again just ignore it. Basically this code now just loops through the entire data. How could I edit this code to just find each route once? Thanks in advance to anyone willing to help me. Here is the code.

Option Compare Text

Sub MatchCorrectTimes()
    'CLICK HERE AND PRESS F5 TO START SCRIPT
  
    For Each w In Workbooks
    If UCase(w.Name) Like UCase("*Pick*order*") Then
    Windows(w.Name).Activate
    Exit For
    End If
    Next w

    Dim dsp As Workbook         'DISPATCH
    Dim crtx As Workbook        'CX
    Dim rngCTX As Range         'CX RANGE
    Dim sq As Range             'SPARE RANGE
    Dim PO As Worksheet         'PICKORDER SHEET
    Dim i As Long               'ITERATION

    'FIND PICKORDER WORKBOOK & SHEET
    For i = 1 To Workbooks.Count
        If InStr(Workbooks(i).Name, "Pickorder") Then
            Set dsp = Workbooks(i)
        End If
    Next i

    For i = 1 To dsp.Worksheets.Count
        If InStr(Worksheets(i).Name, "Pickorder") Then
            Set PO = dsp.Sheets(Worksheets(i).Name)
        End If
    Next i


    'SET OTHER OBJECTS
    Set crtx = Workbooks("MC Checklist .xlsm")
    Set rngCTX = crtx.Sheets("CX Times").Range("A1:A5000")



    Dim RC As String            'ROUTE CODE
    Dim tRow As Long            'TARGET ROW
    Dim lastRow As Long         'LAST ROW

    lastRow = PO.Range("A1").End(xlDown).Row()

    'PROCEED DOWN COLUMN B LOOKING FOR DATA TO UPDATE
    For tRow = 2 To lastRow
        'DEFINE ROUTE CODE
        RC = PO.Range("B" & tRow).Value

        'LOOK THROUGH CX FOR MATCHING ROUTE CODE
        For Each sq In rngCTX

            'IF FOUND
            If sq.Value = RC Then

                'COPY ROW BELOW FOUND ROUTE CODE TO COLUMN A OF DISPATCH
                PO.Range("A" & tRow).Value = sq.Offset(1, 0).Value

            End If
        Next sq
    Next tRow



End Sub

 

[offthelip]

Just add an EXIT For statement inside the if statement :

'IF FOUND
            If sq.Value = RC Then

                'COPY ROW BELOW FOUND ROUTE CODE TO COLUMN A OF DISPATCH
                PO.Range("A" & tRow).Value = sq.Offset(1, 0).Value
                Exit For
            End If

 

[Indominus]

Just add an EXIT For statement inside the if statement :

'IF FOUND
            If sq.Value = RC Then

                'COPY ROW BELOW FOUND ROUTE CODE TO COLUMN A OF DISPATCH
                PO.Range("A" & tRow).Value = sq.Offset(1, 0).Value
                Exit For
            End If

Thank you! I really appreciate it. It works.