I have a table with the following data in Excel:

Christian Florida 1
Katie Wisconsin 1
Sean Alabama 2
Kelly Georgia 2
Kellyn South Carolina 3
Matt Texas 3

What I am trying to do is find all possible combinations based on the numbers without duplicates and set them opposite to each other like this:

Christian Florida 1 2 Alabama Sean
Christian Florida 1 2 Georgia Kelly
Christian Florida 1 3 South Carolina Kellyn
Christian Florida 1 3 Texas Matt
Katie Wisconsin 1 2 Alabama Sean
Katie Wisconsin 1 2 Georgia Kelly
Katie Wisconsin 1 3 South Carolina Kellyn
Katie Wisconsin 1 3 Texas Matt
Sean Alabama 2 3 South Carolina Kellyn
Sean Alabama 2 3 Texas Matt
Kelly Georgia 2 3 South Carolina Kellyn
Kelly Georgia 2 3 Texas Matt

The VBA code I am currently working with is the following but I get too many combinations. I don't need to combine "1" with another "1" for example and I also don't want combinations shown again in the opposite direction. If a combination of "2" and "3" is displayed I don't need the same combination shown again as "3" and "2".

Sub CopyStuff()
    Dim ws As Worksheet, ws1 As Worksheet
    Dim rng As Range, rcell As Range
    Dim LR As Long, lResize As Long
    
    Set ws = Sheets("Sheet1")
    Set ws1 = Sheets("Sheet2")
    
    Set rng = ws.Range("A1:C" & ws.Range("A" & ws.Rows.Count).End(xlUp).Row)
    
    For Each rcell In Application.Index(rng, 0, 3)
        If IsNumeric(rcell.Value) Then
            LR = ws1.Range("A" & ws1.Rows.Count).End(xlUp).Row + 1
            With rng
                .AutoFilter Field:=3, Criteria1:="<>" & rcell.Value
                .Offset(1).Columns(3).SpecialCells(xlCellTypeVisible).Copy
                ws1.Range("D" & LR).PasteSpecial xlPasteValues
                .Offset(1).Columns(2).SpecialCells(xlCellTypeVisible).Copy
                ws1.Range("E" & LR).PasteSpecial xlPasteValues
                .Offset(1).Columns(1).SpecialCells(xlCellTypeVisible).Copy
                ws1.Range("F" & LR).PasteSpecial xlPasteValues
                lResize = ws1.Range("D" & ws1.Rows.Count).End(xlUp).Row
                .AutoFilter
                .Range(rcell, rcell.Offset(0, -2)).Copy
                ws1.Range("A" & LR & ":C" & lResize).PasteSpecial xlPasteValues
            End With
        End If
    Next rcell
    
End Sub