Find value of combobox1 selection, add adjacent cells to combobox2 without duplicates.

[Mike Neal]

I have a combobox that the user selects a location from. Based on the location selected I have a second combobox that the user can select an equipment ID from and then a third combobox that the user can select a task from. Everything is working ok except for the second combobox. It populates the equipment IDs but has duplicates. I would like to remove the duplicates. Any help would be appreciated. Thank you.

Here is the code I am using for the second combobox:

Private Sub TASKS_LOCATION_SELECT_BOX_DropButtonClick()
'*********************************************************************************************************************
'This routine looks at the Location selected and populates the Equip ID combobox with ID's set to that Location.
'*********************************************************************************************************************
TASKS_EQUIP_ID_LIST.Clear 'Clears old entries from list.

Dim txtVal As String

If IsNull(Me.TASKS_LOCATION_SELECT_BOX.value) = False Then 'Looks at selected Location.
txtVal = Me.TASKS_LOCATION_SELECT_BOX.value
Else
txtVal = ""
End If

Dim rng As Range
Set rng = ThisWorkbook.Sheets("Task Due Dates").Range("C2:C750") 'Where to look for Location.
Dim rCell As Range

For Each rCell In rng.Cells 'Check each cell in range.

If rCell.value = txtVal Then 'If cell contains a Location.

With Me.TASKS_EQUIP_ID_LIST

.AddItem rCell.Offset(0, -2).value 'Add Equip ID to list.

End With

End If

Next rCell 'Check each cell.

End Sub


Here is my spreadsheet:

Equip ID	Task ID	Location
R501	T101	REVLIS 2
R400	T202	REVLIS 4
R300	T101	REVLIS 3
R300	T105	REVLIS 3
R400	T107	REVLIS 4
R303	T105	AKROCHEM
R303	T107	AKROCHEM
R305	T107	REVLIS 3
R400	T106	REVLIS 4
R501	T105	REVLIS 2

 

[Fluff]

How about

   TASKS_EQUIP_ID_LIST.Clear 'Clears old entries from list.

   Dim txtVal As String
   Dim rCell As Range
      
   If Me.TASKS_LOCATION_SELECT_BOX.Value = "" Then Exit Sub
   txtVal = Me.TASKS_LOCATION_SELECT_BOX.Value
   
   With CreateObject("scripting.dictionary")
      For Each rCell In ThisWorkbook.Sheets("Task Due Dates").Range("C2:C750")
         If rCell.Value = txtVal Then .Item(rCell.Offset(, -2)) = Empty 'If cell contains a Location.
      Next rCell 'Check each cell.
      Me.TASKS_EQUIP_ID_LIST.List = .Keys
   End With

 

[Mike Neal]

How about

   TASKS_EQUIP_ID_LIST.Clear 'Clears old entries from list.

   Dim txtVal As String
   Dim rCell As Range
     
   If Me.TASKS_LOCATION_SELECT_BOX.Value = "" Then Exit Sub
   txtVal = Me.TASKS_LOCATION_SELECT_BOX.Value
  
   With CreateObject("scripting.dictionary")
      For Each rCell In ThisWorkbook.Sheets("Task Due Dates").Range("C2:C750")
         If rCell.Value = txtVal Then .Item(rCell.Offset(, -2)) = Empty 'If cell contains a Location.
      Next rCell 'Check each cell.
      Me.TASKS_EQUIP_ID_LIST.List = .Keys
   End With

Fluff,
This code puts the list in with no duplicates but something weird seems to be happening. When I click on the TASKS_EQUIP_ID drop down there are blanks. If I click on a blank the drop down closes and there is an Equip ID present. IF I click on the drop down again everything is blank and when I click on a different blank a different Equip ID is there when the drop down closes.

 

[Fluff]

Try

Me.TASKS_EQUIP_ID_LIST.List = Application.Transpose(.Keys)

 

[Mike Neal]

Fluff,
I changed the code like you suggested. The values are now visible but duplicates are back in the drop down. Thank you for the assistance.

 

[Fluff]

If you are getting duplicates it sounds as though some of the values may have leading/trailing spaces.

 

[Mike Neal]

I have the format on the sheet to center the data in the cell but I don't have any spaces (As in hitting the space bar before or after entering the data).

 

[Fluff]

Oops, missed abit, it should be

  TASKS_EQUIP_ID_LIST.Clear 'Clears old entries from list.

   Dim txtVal As String
   Dim rCell As Range
      
   If Me.TASKS_LOCATION_SELECT_BOX.Value = "" Then Exit Sub
   txtVal = Me.TASKS_LOCATION_SELECT_BOX.Value
   
   With CreateObject("scripting.dictionary")
      For Each rCell In ThisWorkbook.Sheets("Task Due Dates").Range("C2:C750")
         If rCell.Value = txtVal Then .Item(rCell.Offset(, -2).Value) = Empty 'If cell contains a Location.
      Next rCell 'Check each cell.
      Me.TASKS_EQUIP_ID_LIST.List = .Keys
   End With

 

[Mike Neal]

That works perfectly! Thanks so much for the assistance.

 

[Fluff]

You're welcome & thanks for the feedback.