Home > Blockchain >  Remove duplicate lines, only per each cell on a column
Remove duplicate lines, only per each cell on a column

Time:05-07

enter image description here

I have duplicates lines on each cell, these lines are merely URL address separated by vbLf.
I need to remove duplicate lines, but only per each cell on the column.
I found the below function, but it removes words only per each cell.
In advance, grateful for any helpful comments and answers.

Function RemoveDupeWords(text As String, Optional delimiter As String = " ") As String
    Dim dictionary As Object
    Dim x, part
 
    Set dictionary = CreateObject("Scripting.Dictionary")
    dictionary.CompareMode = vbTextCompare
    For Each x In Split(text, delimiter)
        part = Trim(x)
        If part <> "" And Not dictionary.Exists(part) Then
            dictionary.Add part, Nothing
        End If
    Next
 
    If dictionary.Count > 0 Then
        RemoveDupeWords = Join(dictionary.keys, delimiter)
    Else
        RemoveDupeWords = ""
    End If
 
    Set dictionary = Nothing
End Function

CodePudding user response:

Maybe this will do the trick

    Function RemoveDupeLine() As String
  
    Dim coll As Collection
    
    Dim i As Long, c, txt As String, arr As Variant
    
    Dim rng As Range: Set rng = ThisWorkbook.Worksheets(1).Range("A1").CurrentRegion
    
    For Each c In rng
        Set coll = New Collection
        arr = Split(c.Value, vbLf)
          For i = LBound(arr) To UBound(arr)
                On Error Resume Next
                  coll.Add Item:=arr(i), Key:=arr(i)
                On Error GoTo 0
          Next i
          
       If coll.Count > 0 Then
            For i = 1 To coll.Count
               txt = txt & coll(i) & vbLf
            Next i
         c.Value = txt
         txt = ""
        Set coll = Nothing
        
       End If
    Next
     
End Function

good lock

CodePudding user response:

If you have Windows Excel 2019 , you can do this with a formula:

=TEXTJOIN(CHAR(10),,FILTERXML("<t><s>"& SUBSTITUTE(A2,CHAR(10),"</s><s>")& "</s></t>","//s[not (preceding::*=.)]"))

enter image description here

Also, if you have the latest office 365 insiders version, you could replace FILTERXML with the new TEXTSPLIT function.

  • Related