Hopefully I understand better now try this, it does do the recursive bit.
Dim str As String
Dim status As String
Dim inarr() As Variant
Dim lastrow As Integer
Dim outpt As String
Dim com As String
Sub findit()
Dim str As String
With Worksheets("Sheet1")
lastrow = .Cells(Rows.Count, "A").End(xlUp).Row
inarr = Range(.Cells(1, 1), .Cells(lastrow, 3))
Range(.Cells(1, 4), .Cells(lastrow, 4)) = ""
outarr = Range(.Cells(1, 4), .Cells(lastrow, 4))
outpt = ""
'For jj = 2 To lastrow
For jj = 2 To 20
str = inarr(jj, 2)
status = "Next"
com = "'"
Do While status = "Next"
Call findone(str, inarr, lastrow, status)
com = ","
Loop
outarr(jj, 1) = outpt
outpt = ""
Next jj
Range(.Cells(1, 4), .Cells(lastrow, 4)) = outarr
End With
End Sub
Sub findone(str As String, inarr() As Variant, lastrow As Integer, status As String)
fnd = False
For i = 2 To lastrow
If str = inarr(i, 2) Then
If str = inarr(i, 3) Then
' end of line
status = "Dead end"
fnd = True
outpt = outpt & com & inarr(i, 1)
Exit For
Else
str = inarr(i, 3)
status = "Next"
fnd = True
outpt = outpt & com & inarr(i, 1)
Exit For
End If
End If
Next i
If Not (fnd) Then
status = "Not found"
End If
End Sub