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