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

Hi adribas,

Try below code ...

Sub test()

Dim a
a = Range("B4", Range("B" & Rows.Count).End(3))
ReDim b(1 To UBound(a), 1 To 1)

With CreateObject("scripting.dictionary")
   For x = 1 To UBound(a)
      For y = 0 To UBound(Split(a(x, 1), vbLf))
         j$ = Split(a(x, 1), vbLf)(y)
         If Not .exists(j) Then
            .Add j, Nothing
            b(x, 1) = IIf(Len(b(x, 1)), b(x, 1) & vbLf & j, j)
         End If
      Next
   Next
End With

[E4].Resize(UBound(b)) = b

End Sub

Hello,

as the delimiter can't be a carriage return !

Anyway according to the attachment with the correct Excel delimiter a VBA basics demonstration for starters :

PHP Code: 

Sub Demo1()
      Const D = "¤"
        Dim V, R&, S&, C%, T$
    With [B3].CurrentRegion
        V = .Value
    With New Collection
        On Error Resume Next
    For R = 2 To UBound(V)
        V(R, 1) = Split(V(R, 1), vbLf)
    For S = 0 To UBound(V(R, 1))
        C = 0
        T = Trim(Split(V(R, 1)(S), "-")(1))
        C = .Item(T)
        If C Then V(R, 1)(S) = D Else .Add 1, T
    Next
        V(R, 1) = Join(Filter(V(R, 1), D, False), vbLf)
    Next R
        On Error GoTo 0
    End With
       .Value = V
    End With
End Sub 


► Do you like it ? ► ► So thanks to click on bottom left star icon « ★ Add Reputation » ! ◄ ◄

Hi adribas,

If you had the latest version of Excel 365 you could use the newer =TextJoin and =TextSplit functions and do your problem with this formula:

Formula:

=UNIQUE(TEXTSPLIT(TEXTJOIN(CHAR(10),,$B$4:$B$7),,CHAR(10),TRUE))

See the attached..
sample filtering repeated words answer.xlsx
By the way you have an extra space in - orange is a fruit so it doesn't match -orange is a fruit.

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

Hi all, I'm attaching the original file here. IT's not sensitive info and can be freely found on the internet. Just so the request is clear, I need a script that goes through each column, reads each sentence within a cell, and look for duplicates within the column and remove the duplicates, keeping only the first instance.

Originally Posted by Marc L

Such a bad initial post attachment !

This comment is not constructive. Either provide specific areas of improvement or don't comment.

In Excel 365 is this also possible with a formula:

Formula:

=LET(i,TRIM(TEXTSPLIT(B4,"-",,1)),t,REDUCE("",B$3:B3,LAMBDA(a,b,HSTACK(a,TRIM(TEXTSPLIT(b,"-",,1))))),f,"- "&TEXTJOIN("- ",,IFERROR(FILTER(i,ISNA(MATCH(i,t;0))),"")),f)