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
