Combine Comma Delimited 2 Cells data and remove duplicate

To combine two cells (comma delimited data) into one cell by removing duplicates.
User the following function.

Public Function PS_Combined(ByVal fRange As Range, ByVal sRange As Range) As String

   
   
    Dim CombinedArray() As String
    Dim ResultArray() As String
    'Dim UniqueVals As New Collection
    Dim myVal
    Dim myVar
     Dim PS_Result As String
   
     Dim i As Integer
     i = 0
     Dim r As Integer
     r = 0
   
     Dim sameWord As Boolean
     sameWord = False
   
     Dim combinedString As String
   
     combinedString = fRange.Cells.Value & "," & sRange.Cells.Value
   
     CombinedArray = Split(combinedString, ",")

     For Each myVal In Split(combinedString, ",")
         i = i + 1
     Next myVal


Dim fValue As String
Dim sValue As String

    For p = 0 To i - 1
        sameWord = False
        fValue = CombinedArray(p)



        For j = (p + 1) To (i - 1)
          sValue = CombinedArray(j)

        'MsgBox "P:" & p & ",,,,J:" & j

        If StrComp(fValue, sValue, vbTextCompare) = 0 Then
           sameWord = True
        End If

        'MsgBox "First:" & fValue & " AND " & sValue & " ARE " & sameWord

        Next j



       If sameWord = False Then
'         MsgBox "Before:" & PS_Result
'           MsgBox "New Add:" & fValue
           PS_Result = PS_Result & "," & fValue
           r = r + 1
       End If



    Next p

          'PS_MM = combinedString
         PS_Combined = Mid(PS_Result, 2, Len(PS_Result))
     
     

     
     
End Function


Download Example>>https://skitfy-my.sharepoint.com/:x:/p/pyisoe/EWldVaezQd5EhGO_3Z3Y6fYBL6nCsIQR01NExGDr148Kxg?e=iaNZ6X

Share This

Facebook

Twitter

Google+

LinkedIn

Related Posts