Split and remove duplicates, then join back

Question

I've got this far with splitting the values I've got from Column "N". The only thing is, that I somehow can't get to remove duplicates and then join everything back together with a ",". As a newbie I'm struggling with arrays and mostly get “run-time error 13 – Type mismatch”.

My output looks like this:

'strModel:          Row 2: Toyota Verso '09-... (R2)
'strModel:          Row 2: Toyota Verso '09-... (R2)
'Model3:            ROW 3: -
'strModel:          Row 4: Toyota Avensis '97-'02 (T22)
'strModel:          Row 4: Toyota Auris '07-'13 (E15)
'Model3:            ROW 5: -
'Model3:            ROW 6: -
'Model3:            ROW 7: -
'Model3:            ROW 8: -
'strModel:          Row 9: Toyota RAV4 '05-'12 (A3)
'Model3:            ROW 10: -
'Model3:            ROW 11: -
'strModel:          Row 12: Toyota Auris '07-'13 (E15)
'strModel:          Row 13: Toyota Avensis '97-'02 (T22)

EXAMPLE: The input from Column "N", Row 2 (= Duplicate):

Toyota Verso/Toyota Verso '09-... (R2)/Carrosserie/Grille;Toyota Verso/Toyota Verso '09-... (R2)/Overige

This is the output I want to achieve:

'strModel:          Row 2: Toyota Verso '09-... (R2)
'Model3:            ROW 3: -
'strModel:          Row 4: Toyota Avensis '97-'02 (T22), Toyota Auris '07-'13 (E15)
'Model3:            ROW 5: -
'Model3:            ROW 6: -
'Model3:            ROW 7: -
'Model3:            ROW 8: -
'strModel:          Row 9: Toyota RAV4 '05-'12 (A3)
'Model3:            ROW 10: -
'Model3:            ROW 11: -
'strModel:          Row 12: Toyota Auris '07-'13 (E15)
'strModel:          Row 13: Toyota Avensis '97-'02 (T22)

This is the working code I have for now:

    Option Explicit

    Sub Sample()

    Dim oWS As Worksheet
    Dim fill As String
    Dim x As Long
    Dim i As Long
    Dim strMODEL As String
    Dim strMODELS() As String
    Dim Model2 As Variant
    Dim Model3 As Variant
    Dim myElements() As String
    Dim myString As String
    Dim LastRow As Long

    Set oWS = Sheets("Sheet1")
    LastRow = oWS.Range("A" & Rows.Count).End(xlUp).Row
    fill = "-"

    For i = 2 To LastRow

        myString = oWS.Cells(i, "N")                                                 ' MODEL
        strMODELS = Split(myString, ";")                                         ' ----- SPLIT 1 -----

        If Len(myString) > 1 Then

            For Each Model2 In strMODELS
                        strMODEL = Split(Model2, "/")(1)                        ' ----- SPLIT 2 -----  2nd Element Of Array
                                    Debug.Print ("strModel:          ROW ") & i & ": " & strMODEL

          '*****************************************************
          ' 1) Remove duplicates from strMODEL
          ' 2) Join everything back separated by ","
          '*****************************************************

                        Next Model2
             Else
                        Model3 = fill
                                    Debug.Print ("Model3:             ROW ") & i & ": " & fill
             End If
    Next i
    End Sub

Answer 1

Try adding a dictionary to help maintain the uniqueness.

Option Explicit

Sub Sample()
    Dim i As Long, arr As Variant, tmp As Variant, str As String
    Dim dict As Object

    Set dict = CreateObject("scripting.dictionary")

    With Worksheets("sheet1")
        arr = .Range(.Cells(2, "N"), .Cells(.Rows.Count, "N").End(xlUp)).Value2

        For i = LBound(arr, 1) To UBound(arr, 1)
            tmp = Split(arr(i, 1), ":", 3)
            str = Join(Array(tmp(0), tmp(1), Space(1)), ":")
            If dict.exists(str) Then
                dict.Item(str) = dict.Item(str) & ", " & Trim(tmp(2))
            Else
                dict.Item(str) = Trim(tmp(2))
            End If
        Next i

        ReDim arr(1 To dict.Count, 1 To 1)
        i = LBound(arr, 1)

        For Each tmp In dict.keys
            arr(i, 1) = tmp & dict.Item(tmp)
            i = i + 1
        Next tmp

        .Cells(2, "O").Resize(UBound(arr, 1), UBound(arr, 2)) = arr
    End With
End Sub