excel – '.Find'/'.FindNext' finding same cell repeatedly or returns error

Here is an efficient solution to your problem that does not use the .Find or .FindNext methods.

Sub Match2Cohort()
    Dim i&, k&, TTmp$, PTmp$, p, t
    t = [f1].CurrentRegion.Resize(, 2)
    With ActiveSheet
        p = [b1].Resize(.Cells(.Rows.Count, "b").End(xlUp).Row, 2)
    End With
    For i = 1 To UBound(t)
        TTmp = LCase$(Replace(t(i, 1), " ", ""))
        For k = 1 To UBound(p)
            PTmp = "," & LCase$(Replace(p(k, 1), " ", "")) & ","
            If InStr(PTmp, "," & TTmp & ",") Then
                PTmp = p(k, 2) & "/" & t(i, 2)
                If Left$(PTmp, 1) = "/" Then PTmp = Mid$(PTmp, 2)
                p(k, 2) = PTmp
            End If
        Next
    Next
    [b1].Resize(UBound(p), UBound(p, 2)) = p
End Sub

I think this is what you’re trying to write:

Sub Match2Cohort()

    Dim Phenotype As Range, FindMe As String, FoundinList As Range
    Dim LRp As Long, LastRow As Long, i As Long
    Dim FirstMatch As String
    Dim Terms As Range

    LRp = Cells(Rows.Count, 2).End(xlUp).Row
    LastRow = Cells(Rows.Count, 6).End(xlUp).Row
    Set Phenotype = Range("B1:B" & LRp)
    Set Terms = Range("F1:F" & LastRow)

    For i = 18 To LastRow
        FindMe = Cells(i, 6).Value2

        'Find first occurrence.
        Set FoundinList = Phenotype.Cells.Find( _
            What:=FindMe, _
            After:=Phenotype.Cells(1), _
            LookAt:=xlPart, _
            SearchDirection:=xlNext)

        If Not FoundinList Is Nothing Then
            FirstMatch = FoundinList.Address
            Do
                If IsEmpty(FoundinList.Offset(0, 1)) Then 'No need for "=TRUE" as the statement returns TRUE/FALSE
                    FoundinList.Offset(0, 1) = Cells(i, 7).Value
                Else
                    FoundinList.Offset(0, 1) = FoundinList.Offset(0, 1).Value & "/" & Cells(i, 7).Value
                End If

                Set FoundinList = Phenotype.FindNext(FoundinList)
            Loop While Not FoundinList Is Nothing And FirstMatch <> FoundinList.Address
        End If

    Next i

End Sub

Ok, so i think the best solution is to move away from FIND() and use strings.split, and application.index and application.match

Here’s the logic:

Loop 1 ‘loop through cells in column B

Split the cells text at the comma and place in an array

Loop 2 ‘ loop through individual Phenotype array

Use application.match to find the term and code in columns F:G

Add the code to the cell in column C.

And here is the code:

Sub Text_Loop()
Dim i As Integer
Dim RngF as Range, RngB As Range
Dim mycell As Range
Dim phenoString() As String
Dim phenoCode As Variant

Set RngB = Sheet1.Range("b2:b" & Sheet1.Range("b2").End(xlDown).Row)
Set RngF = Sheet1.Range("F2:F" & Sheet1.Range("F2").End(xlDown).Row)

For Each mycell In RngB 'first loop
    phenoString = Split(mycell.Value, ",")

    For i = LBound(phenoString) To UBound(phenoString) 'second loop
        phenoCode = Application.Index(Sheet1.Range("F2:G" & Sheet1.Range("F2").End(xlDown).Row), _
            Application.Match(phenoString(i), RngF, 0), 2) 'use variant so that we can check for an error

        If WorksheetFunction.IsError(phenoCode) = False Then 'checks to make sure phenocode was found
            If mycell.Offset(0, 1) <> "" Then 'formats multiple phenotype codes with / in correct place
                mycell.Offset(0, 1) = mycell.Offset(0, 1) & "/" & phenoCode
            Else
                mycell.Offset(0, 1) = phenoCode
            End If
        End If

    Next i 'end first loop
Next mycell 'end second loop


End Sub