Click here to Skip to main content
14,734,364 members
Please Sign up or sign in to vote.
0.00/5 (No votes)
See more:
Quote:
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


What I have tried:

I have tried different codes to remove the duplicates from an array but does not able to get the suitable code to remove duplicate that can suit to my code and meet my condition.
Posted
Updated 27-Aug-20 3:43am
Comments
[no name] 26-Aug-20 16:25pm
   
So you think it is ok to compare the 'splitted oldVal' with the 'unsplitted newVal' here If El = newVal Then?

1 solution

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



Quote:
Is this code to remove the duplicate will work for my code
   
Comments
CHill60 27-Aug-20 8:56am
   
Is this meant to be a solution to your own problem or is it further information about your question?
Bhushan Agrawal JSR 27-Aug-20 10:04am
   
It is question that whether this code will remove duplicates from my array list?
Bhushan Agrawal JSR 27-Aug-20 10:06am
   
Is this second code is right ? will it remove the duplicate from my code ?
CHill60 28-Aug-20 14:24pm
   
By posting a solution you have removed your post from the unanswered questions list. Use "Improve Question" link to add information and delete this non-solution

This content, along with any associated source code and files, is licensed under The Code Project Open License (CPOL)




CodeProject, 20 Bay Street, 11th Floor Toronto, Ontario, Canada M5J 2N8 +1 (416) 849-8900