Excel Combobox with additional selection criteria

I have a combobox that reflects a list (in a different tab) without duplications.

At the moment it is selecting names in columnC. Additionally, I want to show only those names that meet a criteria in columnA. The selection criteria is entered in cell M1 of the base sheet.

Here's my code I use so far.

Private Sub worksheet_Activate()
Dim AllCells As Range, Cell As Range
Dim NoDupes As New Collection
Dim i As Integer, j As Integer
Dim Swap1, Swap2, Item
Dim rng As Range

Me.combobox1.Clear

Set AllCells = Worksheets("NKADaten").Range("C4:C200")
On Error Resume Next
For Each Cell In AllCells
NoDupes.Add Cell.Value, CStr(Cell.Value)
Next Cell
On Error GoTo 0
For i = 1 To NoDupes.Count - 1
For j = i + 1 To NoDupes.Count
If NoDupes(i) > NoDupes(j) Then
Swap1 = NoDupes(i)
Swap2 = NoDupes(j)
NoDupes.Add Swap1, before:=j
NoDupes.Add Swap2, before:=i
NoDupes.Remove i + 1
NoDupes.Remove j + 1
End If
Next j
Next i
For Each Item In NoDupes
Me.combobox1.AddItem Item
Next Item
End Sub

Many thanks for your help.

Sven

I'd modify this portion:

On Error Resume Next
For Each Cell In AllCells
NoDupes.Add Cell.Value, CStr(Cell.Value)
Next Cell
On Error GoTo 0

to check that criteria:

On Error Resume Next
For Each Cell In AllCells
if lcase(cell.offset(0,-2).value) _
= lcase(worksheets("base").range("M1").value) then
NoDupes.Add Cell.Value, CStr(Cell.Value)
end if
Next Cell
On Error GoTo 0

But that's without knowing what "meet a criteria in column A" really means. I'm
guessing that you mean equals--but that's just a guess.

sven_dau wrote:
>
> I have a combobox that reflects a list (in a different tab) without
> duplications.
>
> At the moment it is selecting names in columnC. Additionally, I want to
> show only those names that meet a criteria in columnA. The selection
> criteria is entered in cell M1 of the base sheet.
>
> Here's my code I use so far.
>
> Private Sub worksheet_Activate()
> Dim AllCells As Range, Cell As Range
> Dim NoDupes As New Collection
> Dim i As Integer, j As Integer
> Dim Swap1, Swap2, Item
> Dim rng As Range
>
> Me.combobox1.Clear
>
> Set AllCells = Worksheets("NKADaten").Range("C4:C200")
> On Error Resume Next
> For Each Cell In AllCells
> NoDupes.Add Cell.Value, CStr(Cell.Value)
> Next Cell
> On Error GoTo 0
> For i = 1 To NoDupes.Count - 1
> For j = i + 1 To NoDupes.Count
> If NoDupes(i) > NoDupes(j) Then
> Swap1 = NoDupes(i)
> Swap2 = NoDupes(j)
> NoDupes.Add Swap1, before:=j
> NoDupes.Add Swap2, before:=i
> NoDupes.Remove i + 1
> NoDupes.Remove j + 1
> End If
> Next j
> Next i
> For Each Item In NoDupes
> Me.combobox1.AddItem Item
> Next Item
> End Sub
>
> Many thanks for your help.
>
> Sven
>
> --
> sven_dau
> ------------------------------------------------------------------------
> sven_dau's Profile: http://www.excelforum.com/member.php...o&userid=35291
> View this thread: http://www.excelforum.com/showthread...hreadid=561105

--

Dave Peterson

Dave,

You made my day. It works.
Amazing how small things can make you happy.

Many thanks,

Sven

Dave, how would it look like if I had another additional criteria to be checked (say in M2) with column B?

Just repeating the first if function and replacing M1 with M2 and changing column to -1 doesn't do the trick.

Maybe...

On Error Resume Next
For Each Cell In AllCells
if lcase(cell.offset(0,-2).value) _
= lcase(worksheets("base").range("M1").value) then
if lcase(cell.offset(0,-1).value) _
= lcase(worksheets("base").range("M2").value) then
NoDupes.Add Cell.Value, CStr(Cell.Value)
end if
end if
Next Cell
On Error GoTo 0



sven_dau wrote:
>
> Dave, how would it look like if I had another additional criteria to be
> checked (say in M2) with column B?
>
> Just repeating the first if function and replacing M1 with M2 and
> changing column to -1 doesn't do the trick.
>
> --
> sven_dau
> ------------------------------------------------------------------------
> sven_dau's Profile: http://www.excelforum.com/member.php...o&userid=35291
> View this thread: http://www.excelforum.com/showthread...hreadid=561105

--

Dave Peterson

Great, I forgot second end if.
Many thanks!