Remove Duplicates and make unique list

Question

The Fruits contains list - Apple,Banana,Orange and Colors contains list - Red,Black,Orange

so when I multi select the Fruits as well as Colors from drop-down list from cell "G1". Then the "Offset(0, -1)" means "F1" shows me the combine output list as - (Apple, Banana, Orange, Red, Black, Orange). So, The list in cell "F1" contains duplicate value Orange and it prints 2 times. It should pick up only unique items from the selected one and remove the duplicate one and should print in cell F1 as - (Apple, Banana, Orange, Red, Black).

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
 Dim rngDV As Range, oldVal As String, newVal As String
 Dim arr As Variant, El As Variant

 If Target.count > 1 Then GoTo exitHandler
 If Target.value = "" Then
   Application.EnableEvents = False
     Target.Offset(0, -1).value = ""
   Application.EnableEvents = True
   Exit Sub
 End If
 
 On Error Resume Next
 Set rngDV = cells.SpecialCells(xlCellTypeAllValidation)
 On Error GoTo exitHandler

 If rngDV Is Nothing Then GoTo exitHandler

 If Not Intersect(Target, rngDV) Is Nothing Then
   Application.EnableEvents = False
   newVal = Target.value: Application.Undo
   oldVal = Target.value: Target.value = newVal
  
   If Target.Column = 7 Then
    If oldVal <> "" Then
      If newVal <> "" Then
         arr = Split(oldVal, ",")
         For Each El In arr
            If El = newVal Then
                Target.value = oldVal
                GoTo exitHandler
            End If
         Next
         Target.value = oldVal & "," & newVal
         Target.EntireColumn.AutoFit
      End If
    End If
   End If
   writeSeparatedStringLast Target
End If

exitHandler:
  Application.EnableEvents = True
End Sub

Sub writeSeparatedStringLast(rng As Range)
  Dim arr As Variant, arrFin As Variant, El As Variant, k As Long, listBox As MSForms.listBox
  Dim arrFr As Variant, arrVeg As Variant, arrAnim As Variant, El1 As Variant
  Dim strFin As String ', rng2 as range
  
   arrFr = Split("Apple,Banana,Orange", ",")
   arrVeg = Split("Onion,Tomato,Cucumber", ",")
   arrAnim = Split("Red,Black,Orange", ",")
  arr = Split(rng.value, ",")

  For Each El In arr
    Select Case El
        Case "Fruits"
            arrFin = arrFr
        Case "Vegetables"
            arrFin = arrVeg
        Case "Colors"
            arrFin = arrAnim
    End Select
    For Each El1 In arrFin
        strFin = strFin & El1 & ", "
    Next
  Next
  strFin = left(strFin, Len(strFin) - 1)
  With rng.Offset(0, -1)
    .value = strFin
    .WrapText = True
    .Select
  End With
End Sub

'Firstly run the next Sub, in order to create a list validation in range "G1":
Sub CreateValidationBis()
 Dim sh As Worksheet, rng As Range
 Set sh = ActiveSheet
 Set rng = sh.Range("G1")
 
 With rng.Validation
    .Delete
    .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
                   Operator:=xlBetween, Formula1:="Fruits,Vegetables,Colors"
    .IgnoreBlank = True
    .InCellDropdown = True
    .ShowInput = True
    .ShowError = True
 End With
End Sub

It does not contain duplicate values, it contains the unique values for both list, you have a fruit and a color with the same name, the name is unique to both list, thus when you combine them, you have "Orange" unique for both fruit and color. If you had the fruit "Peach" and the color "Peach" you would get the same result. — GMalc
But this is just an example i have putted here , That if I selected Fruits and Color from the drop-down then it will list me in F1 cell as - Apple, Banana, Orange, Red, Black, Orange . So, Orange will be printed two times in the cell, just an example . I want to avoid this and want to show unique value should show Orange once in list . — Bhushan Agrawal JSR
I can think of two possible ways to accomplish what you want: First; combine all the arrays' and then remove the duplicates. Second, after the lists are combined, add code to remove the duplicates in F1. — GMalc
First; All the arrays are combined "strFin = left(strFin, Len(strFin) - 1)" but am not able to put the code to remove the duplicates and don't have the code to remove duplicates for such arrays as in my code.Will you please help me — Bhushan Agrawal JSR

Bhushan Agrawal JSR Bhushan Agrawal JSR · Accepted Answer · 2020-08-27T12:19:46

Is this code will fit to remove the duplicates from output arrays and give me the unique value.

Public Function RemoveDuplicateWords(InputString As String) As String
    Dim InputArray() As String
    InputArray = Split(InputString, " ")

    Dim DictUnique As Object
    Set DictUnique = CreateObject("Scripting.Dictionary")

    Dim OutputString As String

    Dim Word As Variant
    For Each Word In InputArray
        If Not DictUnique.Exists(Word) Then
            DictUnique.Add Word, 1
            OutputString = OutputString & " " & Word
        End If
    Next Word

    RemoveDuplicateWords = Trim$(OutputString)
End Function

Remove Duplicates and make unique list

1 Answers