Hide used items in dropdown list using VBA

[Vincent88]

Hi EveryOne,
I want to make a vba code to hide the used items in dropdown list. I searched and got a possible code so I adjust some changes to fit my need but need help to complete this mission.
Column A of activesheet has a dropdownlist from column N in sheet"Data". If the name is selected, then the name of the dropdown list will shrink to have choice of those unused names for remaining cells in column A to choose.
Please help.

My code is here

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

If Sh.Name = "Data" Then Exit Sub

'DropDownList in Column A

Dim lr1 As Long
lr1 = Range("A3").End(xlDown).Row

Dim lr As Long
lr = Sheets("Data").Range("N1").End(xlDown).Row

Dim FullString As String
FullString = "='Data'!$N$2:$N$" & lr


Dim filledRng As Range
Dim newRng As Range
Dim v As String
Dim PartString As String

Set filledRng = Range("A3:A" & lr1)   
Set newRng = Range("A3:A" & lr1)


If Not Intersect(Target, newRng) Is Nothing Then

[COLOR=rgb(226, 80, 65)]v = filledRng.Value[/COLOR]
PartString = RemoveItem(FullString, v)

With Target.Validation
 .Delete
 .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
 Operator:=xlBetween, Formula1:=PartString
 .IgnoreBlank = True
 .InCellDropdown = True
 .InputTitle = ""
 .ErrorTitle = ""
 .InputMessage = ""
 .ErrorMessage = ""
 .ShowInput = True
 .ShowError = True
End With


End If

End Sub



Public Function RemoveItem(st As String, drop As String) As String
    RemoveItem = Replace(Replace(st, drop, ""), ",,", ",")
End Function

TestDropDownList.xlsm
	A
1	MDate
2	Date
3	Zita V
4	Warus O
5	Robert M
6	Jack S
7	Ken C
8	Mandy H
9	Mary K
10	Peter B
11	Nacy L
12	Larry Q
13	John G
202202

Cells with Data Validation
Cell	Allow	Criteria
A2	List	=List

TestDropDownList.xlsm
	N
1	Agent
2	Bady B
3	Cat G
4	Jack S
5	John G
6	Ken C
7	Larry Q
8	Mandy H
9	Mary K
10	Nacy L
11	Peter B
12	Robert M
13	Warus O
14	Zita V
15	Zita V
Data

 

[jasonb75]

It would work better without vba.

Book1
	A													N	O
1	MDate													Agent	dv_list
2	Date													Bady B	Bady B
3	Zita V													Cat G	Cat G
4	Warus O													Jack S
5	Robert M													John G
6	Jack S													Ken C
7	Ken C													Larry Q
8	Mandy H													Mandy H
9	Mary K													Mary K
10	Peter B													Nacy L
11	Nacy L													Peter B
12	Larry Q													Robert M
13	John G													Warus O
14														Zita V
15														Zita V
Sheet1

Cell Formulas
Range	Formula
O2:O15	O2	=IFERROR(INDEX($N:$N,AGGREGATE(15,6,ROW($N$2:$N$15)/ISERROR(MATCH($N$2:$N$15,$A$3:$A$13,0)),ROWS(O$2:O2))),"")

Cells with Data Validation
Cell	Allow	Criteria
A3:A13	List	=OFFSET($O$2,,,COUNTIF($O$2:$O$15,"?*"))

 

[Vincent88]

Hi jasonb75, Thanks. The column A name cells is a dynamic range, I prefer to use VBA.

 

[Vincent88]

Hi, I tried to use two arrays to make two columns(N and O) in sheet('Data"). Is it possible to compare the values in two columns to find the shortfall then create another column next to them (Column P) to show those shortfall values. Then create dropdown list for Column A in activesheet.

'In Sheet("Data')

Private Sub Worksheet_Change(ByVal Target As Range)
   'Sort Agent Name by alphabetic order
    Dim lr As Long
    Dim Agtarray As Object
    Dim cl As Range
    Dim Sorted_array As Variant
    
    'Creating a array list
    Set Agtarray = CreateObject("System.Collections.ArrayList")
    
    'Physical Source in Column L
    lr = Range("L1").End(xlDown).Row
    Debug.Print lr

    For Each cl In Range("L1:L" & lr)
        If Not Agtarray.contains(cl.Value) Then Agtarray.Add cl.Value
    Next cl
      
    Agtarray.Sort
    Sorted_array = Agtarray.toarray
          
    Range("N1").Resize(UBound(Sorted_array) + 1, 1).Value = Application.Transpose(Sorted_array)
 
End Sub


'In ActiveSheet

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

If Sh.Name = "Data" Then Exit Sub
If Target.CountLarge > 1 Or Target.Columns > 1 Then Exit Sub Then Exit Sub

'DropDownList in Column A
Dim lrA As Long
Dim colAarray As Object
Dim rngA As Range
Dim clA As Range
Dim SortedColA_array As Variant

'Creating a array list
Set colAarray = CreateObject("System.Collections.ArrayList")

'Physical Source in Column L
lrA = Range("A1").End(xlDown).Row
Debug.Print lrA
Set rngA = Range("A3:A" & lrA)


   For Each clA In rngA
      If Not colAarray.contains(clA.Value) Then colAarray.Add clA.Value
   Next clA
  
colAarray.Sort
SortedColA_array = colAarray.toarray

'Output SortedColA_array to Cells
Sheets("Data").Range("O2").Resize(UBound(SortedColA_array) + 1, 1).Value = Application.Transpose(SortedColA_array)

End Sub

TestDropDownList_2.xlsm
	A
1	MDate
2	Date
3	Zita V
4	Viola C
5	Robert M
6	Warus O
7	Ken C
8	Mandy H
9	Mary K
10	Peter B
11	Nancy L
12	Larry Q
13	Cat G
202202

Cells with Data Validation
Cell	Allow	Criteria
A2	List	=List

TestDropDownList_2.xlsm
	N	O	P
1	Agent	From ColumnA	Find Missing bet N & O
2	Cat G	Cat G
3	Jack S	Ken C
4	John G	Larry Q
5	Ken C	Mandy H
6	Larry Q	Mary K
7	Mandy H	Nancy L
8	Mary K	Peter B
9	Nacy L	Robert M
10	Peter B	Viola C
11	Robert M	Warus O
12	Viola C	Zita V
13	Warus O
14	Zita V
Data