remove duplicated from only data validation

abdelfattah

Well-known Member
Joined
May 3, 2019
Messages
995
Office Version
  1. 2010
hello
I search so much in the internet how I can remove duplicated names from data validation as in my code data validation is g1
indeed I 'v found some solution but not perfect I have to filter the column f to remove duplicated but I need it I don't remove duplicated from column f b I would do that directly from data validation I no know if data validation Properties contains that
this is my code
VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Columns(6)) Is Nothing Then
Dim Rng As Range
Set Rng = Range(Range("f1"), Range("f" & Rows.Count).End(xlUp))
With Range("g1").Validation
    .Delete
    .Add Type:=xlValidateList, Formula1:="=" & Rng.Address & ""
End With
End If
End Sub
 

Excel Facts

Move date out one month or year
Use =EDATE(A2,1) for one month later. Use EDATE(A2,12) for one year later.

abdelfattah

Well-known Member
Joined
May 3, 2019
Messages
995
Office Version
  1. 2010
I'm not sure but currently up to 20 sometimes increasable it depends how many items the customer will purchase
 

Peter_SSs

MrExcel MVP, Moderator
Joined
May 28, 2005
Messages
48,535
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

Well, how will I know how many cells to apply the Data validation to?
 

abdelfattah

Well-known Member
Joined
May 3, 2019
Messages
995
Office Version
  1. 2010
so you can apply up to 20 , I don't make hard the matter for you
 

Peter_SSs

MrExcel MVP, Moderator
Joined
May 28, 2005
Messages
48,535
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

so you can apply up to 20
Give this code a try.

VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)
  Dim d As Object
  Dim a As Variant, itm As Variant
  Dim c As Long
  
  If Not Intersect(Target, Columns("F:H")) Is Nothing Then
    'Set up a 'dictionary' to store the DV values.
    'A dictionary does not allow multiple values the same, so it effectively eliminates the duplicates
    Set d = CreateObject("Scripting.Dictionary")
    
    'Cycle through the 3 columns
    For c = 0 To 2
      'Empty the dictionary
      d.RemoveAll
      
      With Columns("F").Offset(, c)
        'Read all the column values into an array (faster than processing worksheet cells individually)
        a = .Resize(.Cells(.Rows.Count).End(xlUp).Row).Value
      End With
      
      'For each value in the array
      For Each itm In a
        'If there is an actual value, put it into the dictionary
        'As noted above the dictionary prohibits duplicates
        If Len(itm) > 0 Then d(itm) = 1
      Next itm
      
      'Now set up the DV
      With Columns("I").Offset(, c).Resize(20).Validation
        .Delete
        'The DV values are obtained by joining all the dictionary values with commas between
        .Add Type:=xlValidateList, Formula1:=Join(d.Keys, ",")
      End With
    Next c
  End If
End Sub
 

abdelfattah

Well-known Member
Joined
May 3, 2019
Messages
995
Office Version
  1. 2010
Fantastic ! the code works surprisingly but I have a problem when create the dropdown lists it also takes the headers from f1,g1,h1 it supposes starting from the row 2 , may you fix itplease ?
 

Peter_SSs

MrExcel MVP, Moderator
Joined
May 28, 2005
Messages
48,535
Office Version
  1. 365
Platform
  1. Windows
Try this

VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)
  Dim d As Object
  Dim a As Variant, itm As Variant
  Dim c As Long
  
  If Not Intersect(Target, Columns("F:H")) Is Nothing Then
    'Set up a 'dictionary' to store the DV values.
    'A dictionary does not allow multiple values the same, so it effectively eliminates the duplicates
    Set d = CreateObject("Scripting.Dictionary")
    
    'Cycle through the 3 columns
    For c = 0 To 2
      'Empty the dictionary
      d.RemoveAll
      
      With Range("F2").Offset(, c)
        'Read all the column values into an array (faster than processing worksheet cells individually)
        a = .Resize(Cells(Rows.Count, .Column).End(xlUp).Row).Value
      End With
      
      'For each value in the array
      For Each itm In a
        'If there is an actual value, put it into the dictionary
        'As noted above the dictionary prohibits duplicates
        If Len(itm) > 0 Then d(itm) = 1
      Next itm
      
      'Now set up the DV
      With Range("I2").Offset(, c).Resize(20).Validation
        .Delete
        'The DV values are obtained by joining all the dictionary values with commas between
        .Add Type:=xlValidateList, Formula1:=Join(d.Keys, ",")
      End With
    Next c
  End If
End Sub
 

abdelfattah

Well-known Member
Joined
May 3, 2019
Messages
995
Office Version
  1. 2010
sorry I was hurry when I Answered you I really did it you're right because I tried mod the code and gives me error then disable
it's a great thanks very much for your cooperating (y)
 
Last edited:

Watch MrExcel Video

Forum statistics

Threads
1,129,804
Messages
5,638,450
Members
417,025
Latest member
MusterDuster

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top