Removing repeated text across several cells (same column) and keeping first instance

try

Sub test()
    Dim a, e, x, i As Long, ii As Long, s As String, myList
    ReDim myList(1 To 10000)
    With [b3].CurrentRegion
        a = .Value
        For i = 2 To UBound(a, 1)
            x = Split(a(i, 1), vbLf)
            a(i, 1) = ""
            For Each e In x
                s = UCase$(Trim$(Mid$(Trim$(e), 2)))
                For ii = 1 To UBound(myList)
                    If myList(ii) = s Then Exit For
                    If myList(ii) = "" Then
                        a(i, 1) = a(i, 1) & IIf(a(i, 1) <> "", vbLf, "") & e
                        myList(ii) = s: Exit For
                    End If
                Next
            Next
        Next
        .Value = a
    End With
End Sub