Compare first word in Multiline and delete the whole line in a multiline cell

[samueljj]

I have a cell with multi line string like illustrated below (The texts like apple, orange will vary)

Apple 45
Apple 34
Orange 1
Pineapple 0
orange 2

I need an output
Apple 45
Orange 1
Pineapple 0

The VBA code should compare the first word of the multiline string and keep the first instance and remove the complete line where the first word is a duplicate.

Appreciate your help in this regard. Thanks in advance

[arnelgp]

Public Function fnUnique(rng As Range)
Dim dict As Object
Dim dOut As Object, val As Variant
Dim var As Variant, i As Integer
Dim sKey As String
Set dict = CreateObject("scripting.dictionary")
Set dOut = CreateObject("scripting.dictionary")
dict.CompareMode = vbTextCompare
dOut.CompareMode = vbTextCompare
val = rng.Value & ""
var = Split(val, Chr(10))
On Error Resume Next
For i = 0 To UBound(var)
sKey = Split(var(i))(0)
If dict.exists(sKey) = False Then
dict.Add Key:=sKey, Item:=var(i)
Else
dOut.Add Key:=var(i), Item:=var(i)
End If
Next
For i = 1 To dOut.Count
val = Replace$(val, dOut.items()(i - 1), "")
Next
If Right$(val, 1) = Chr(10) Then
val = Left$(val, Len(val) - 1)
End If
fnUnique = val
Set dict = Nothing
Set dOut = Nothing
End Function




on an Opposite Cell (B1) write the formula:

=fnUnique(A1)

you need to Format the cell to Wrap the text.

[samueljj]

Thanks Bro for the great help. It worked like a charm :clap: