Try this macro - I have assumed that the cell contents are values and not formulas.

Sub Macro1()
    Dim c As Range
    Dim a As Range
    Dim r As Long
    Dim f As Range
    
    With Worksheets("Sheet1").Sort
        .SortFields.Clear
        .SortFields.Add Key:=Range("A:A"), Order:=xlAscending
        .SortFields.Add Key:=Range("B:B"), Order:=xlAscending
        .SetRange Range("A1").CurrentRegion
        .Header = xlYes
        .Orientation = xlTopToBottom
        .Apply
    End With
    
    For r = Cells(Rows.Count, "A").End(xlUp).Row To 2 Step -1
        If Cells(r, "A").Value <> Cells(r - 1, "A").Value Then
            Cells(r, "A").EntireRow.Insert
        End If
    Next r
    
    For Each a In Range("A:A").SpecialCells(xlCellTypeConstants).Areas
        For Each c In a.Offset(0, 1)
            a.Offset(0, 2).Replace ", " & c.Value, ""
            a.Offset(0, 2).Replace c.Value & ", ", ""
            a.Offset(0, 2).Replace "," & c.Value, ""
            a.Offset(0, 2).Replace c.Value & ",", ""
            a.Offset(0, 2).Replace c.Value, ""
        Next c
    Next a
    
    Range("A:A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    
End Sub