How to match return related cell fields in two separate columns in Excel?

Question

I am trying to create a formula that shows all matching fields but in addition includes the "linked cells." Something like this -

User types in "Brad" and the result box should display "Brad, Adam, Charlie, David" because Brad is linked to Adam and Adam is linked to Charlie and David.

A     B
Adam|Brad
Adam|Charlie
Adam|David
Evan|Fred

Formula:

{IFERROR(IFERROR(INDEX(Column B,SMALL(IF(Column A=InputCriteria,ROW(Column A)-1),ROW(1:1))),INDEX(Column A,SMALL(IF(Column B=InputCriteria,ROW(Column B)-1),ROW(1:1)))),"")}

Answer 1

My name is Brad so I couldn't help myself, I had to give a solution a crack. :-)

Add the following code to a new module in your VBA editor ...

Public Function GetAssociatedNames(ByVal strName As String, ByVal rngCells As Range) As String
    Dim lngRow As Long, lngCol As Long, lngBlanks As Long, objNames As Scripting.Dictionary
    Dim strName1 As String, strName2 As String, i As Long, strNameToAdd As String, x As Long
    Dim lngStart As Long, lngCount As Long, lngForCount As Long

    strName = Trim(strName)

    Set objNames = New Scripting.Dictionary
    objNames.Add strName, strName

    With rngCells
        lngStart = 0

        Do While True
            lngForCount = objNames.Count - 1

            If lngStart > lngForCount Then Exit Do

            For x = lngStart To lngForCount
                strName = objNames.Keys(x)

                lngCount = objNames.Count

                For lngRow = 1 To .Rows.Count
                    strName1 = .Cells(lngRow, 1)
                    strName2 = .Cells(lngRow, 2)

                    If strName1 & strName2 = "" Then
                        lngBlanks = lngBlanks + 1
                    Else
                        lngBlanks = 0

                        If strName1 = strName Then strNameToAdd = strName2
                        If strName2 = strName Then strNameToAdd = strName1

                        If Not objNames.Exists(strNameToAdd) And strNameToAdd <> "" Then objNames.Add strNameToAdd, strNameToAdd
                    End If

                    If lngBlanks = 10 Then Exit For
                Next

                lngStart = lngStart + 1
            Next
        Loop
    End With

    For i = 0 To objNames.Count - 1
        GetAssociatedNames = Trim(GetAssociatedNames & "," & objNames.Keys(i))
    Next

    GetAssociatedNames = Replace(Mid(GetAssociatedNames, 2), ",", ", ")
End Function

... then add a reference to Microsoft Scripting Runtime ...

You can then use the formula in a cell, like thus ...

It worked for me, here's hoping it works for you.