Combine unique words in a single cell from a list of cells

[Analystbycuriosity]

I have a long list of following cells:

A11: XYZ A
A21: XYZ B
A31: XYZ C
A41: XYZ D

My desired Output:

A11: XYZ A B C D

Please help me in to find a function or formula.

 

[Analystbycuriosity]

Rick, Thank you for providing the code. I will work on it by this weekend and revert back.

 

[Analystbycuriosity]

Some of these rules are a bit fuzzy, which makes me suspect that there may be more rules like them, that we can't yet identify because the sample data you've provided was small.
What do you think ?

Gerald, Absolutely right.
Please tell me how to upload an image on this forum.
I will do it in the weekend.

 

[Analystbycuriosity]

Copy all of the following code into a general module and then run the Portfolios macro (output goes to Column B starting at Row 1)...
[TABLE="width: 500"]
<tbody>[TR]
[TD]

Sub Portfolios()
  Dim X As Long, Z As Long, Ar As Range, Data As Range, Result As Variant

[/TD]
[/TR]
</tbody>[/TABLE]

Rick, Thanks a lot. Your code worked for me.
Only one deviation from my desired output.
If there is one instance

e.g. Axis Bank Ltd SunMF (only one cell of Axis Bank)

I get output as

Axis Bank Ltd SunMF SunMF

If more than one instances of any company, i get desired output.

 

[Rick Rothstein]

Rick, Thanks a lot. Your code worked for me.
Only one deviation from my desired output.
If there is one instance

e.g. Axis Bank Ltd SunMF (only one cell of Axis Bank)

I get output as

Axis Bank Ltd SunMF SunMF

If more than one instances of any company, i get desired output.

Do not touch the Portfolios macro (its code is fine) but replace the CommonStart function with the following code...

[table="width: 500"]
[tr]
	[td]Function CommonStart(ByVal V As Variant) As String
  Dim X As Long, L As Long, Letter As String
  If VarType(V) = vbString Then
    V = Split(V, ",")
  ElseIf TypeOf V Is Range Then
    If V.Rows.Count > 1 And V.Columns.Count > 1 Then
      Exit Function
    ElseIf V.Rows.Count > 1 Then
      V = Application.Transpose(V)
    ElseIf V.Columns.Count > 1 Then
      V = Application.Index(V.Value, 1, 0)
    Else
      Exit Function
    End If
  ElseIf Not IsArray(V) Then
    Exit Function
  End If
  If UBound(V) Then
    Do
      L = L + 1
      Letter = Mid(V(LBound(V)), L, 1)
      For X = LBound(V) To UBound(V)
        If Mid(V(X) & X, L, 1) <> Letter Then
          If Len(Letter) Then
            CommonStart = RTrim(Left(V(LBound(V)), InStrRev(Left(V(LBound(V)), L), " ")))
          Else
            CommonStart = V(LBound(V))
          End If
          Exit Function
        End If
      Next
    Loop While Len(Letter)
  Else
    CommonStart = Left(V(0), InStrRev(V(0), " ") - 1)
  End If
End Function[/td]
[/tr]
[/table]