Try this.


Sub MyTest()
Dim Cel1            As Range
    Dim Cel2            As Range
    Dim i               As Long
    Dim j               As Long
    Dim k               As Long
    Dim Col             As Collection
    Dim LastCol         As Long
    Dim LastRow         As Long
    Dim Skip            As Boolean
Set Col = New Collection
    With Sheets("Main")
        LastCol = .Range("IV1").End(xlToLeft).Column
        For j = 2 To LastCol
            LastRow = .Range(Cells(65536, j).Address).End(xlUp).Row
            Set Cel1 = Cells.Find(What:=.Range(Cells(1, j).Address).Text, _
            LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=True)
            If Not Cel1 Is Nothing Then
                For i = 2 To LastRow
                    If Application.WorksheetFunction.CountIf( _
                        .Range(Cells(2, j).Address & ":" & Cells(i, j).Address), _
                        .Range(Cells(i, j).Address).Text) = 1 _
                        And .Range(Cells(i, j).Address).Text <> "" Then
                        Set Cel2 = Cells.Find(What:=.Range(Cells(i, j).Address).Text, _
                        LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=True)
                        If Not Cel2 Is Nothing Then
                            If Cel1.Address <> Cel2.Address Then
                                Skip = False
                                For k = 1 To Col.Count
                                    If Col(k).Value = Cel1.Text & "@@@" & Cel2.Text Or _
                                    Col(k).Value = Cel2.Text & "@@@" & Cel1.Text Then
                                        Skip = True
                                        Exit For
                                    End If
                                Next k
                                If Skip = False Then
                                    Col.Add Cel1.Text & "@@@" & Cel2.Text
                                    MyCon Cel1, Cel2, j + 2
                                End If
                            End If
                        End If
                    End If
                Next i
            End If
        Next j
    End With
End Sub
Also note that some of the names have trailing spaces. For example you have Fred typed in as "Fred " in Column A.