Printing Unique Values (From a column) in a Combobox

[Ealcmhar]

Hi!

So, what I'm trying to accomplish is to pull values from a column and store them in a userform-based combobox without any duplicates showing.

So far, I can accomplish pulling all of the values, including duplicates into the box:
Private Sub UserForm_Initialize()
Dim wbBook As Workbook
Dim wsSheet As Worksheet
Dim rnData As Range
Dim vaData As Variant

Set wbBook = ThisWorkbook
Set wsSheet = wbBook.Worksheets("Scoring")

With wsSheet
Set rnData = .Range(.Range("C2"), .Range("C65536").End(xlUp))
End With

vaData = rnData.Value

With Me.TeamDrop
.Clear
.List = vaData
.ListIndex = -1
End With
End Sub

I tried searching up methods to remove duplicates while loading everything into the combobox, although couldn't find anything other than only retrieving 'unique values' upon execution.

I've attempted using this code:
Sub RemoveDuplicates()
Dim AllCells As Range, Cell As Range
Dim NoDupes As New Collection
Dim i As Integer, j As Integer
Dim Swap1, Swap2, Item

Set AllCells = Range("C2:C100")

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
If Item <> "" Then
frmTeam.TeamBox.AddItem Item
End If
Next Item

End Sub

although the column-range's values are not listed in the combobox.

Is there something I'm missing?

Thank you in advance! :thumb

[GTO]

Hi there,

Do the values need to be sorted? If so, can the range be sorted, or do we need to sort just the unique values?

Mark

[Ealcmhar]

Hi Mark,

The values don't need to be sorted. If they were, only the unique values would need alphabetical sorting, although at this point it isn't a necessity; just getting the code to work would be good enough. :content:

[mohanvijay]

Try this



Dim WS_Uni As Worksheet
Set WS_Uni = ThisWorkbook.Sheets("Scoring")
Dim List_Cbo
With WS_Uni

.Range("c2:c" & .Cells(Rows.Count, 3).End(xlUp).Row).AdvancedFilter xlFilterCopy, , .Range("d2"), True
List_Cbo = WorksheetFunction.Transpose(.Range("d2:d" & .Cells(Rows.Count, 4).End(xlUp).Row))
.Range("d2:d" & .Cells(Rows.Count, 4).End(xlUp).Row).Clear

End With
TeamDrop.List = List_Cbo

[GTO]

Hi!

So, what I'm trying to accomplish is to pull values from a column and store them in a userform-based combobox without any duplicates showing.


Compliments to the clarity in your question:cloud9:

Try something like -

In the userform:

Option Explicit

Private Sub UserForm_Initialize()
Dim rngLastCell As Range
Dim aryValues As Variant
Dim DIC As Object
Dim n As Long

With Sheet1 '<---using the sheet's codename.
'// Ensure that data exists, setting a reference to the last cell with //
'// anything in it, in C2 and thereafter in the column. //
Set rngLastCell = RangeFound(.Range(.Cells(2, "C"), .Cells(.Rows.Count, "C")))
'// In case no data exists, leave a way to skip out. //
If Not rngLastCell Is Nothing Then
'// Data exists? Then create and reference a DIctionary Object. //
Set DIC = CreateObject("Scripting.Dictionary")
'// Grab the values from the range and plunk into an array. //
aryValues = .Range(.Cells(2, "C"), rngLastCell).Value
'// Run through the values. Using the dictionary's keys, we either //
'// add a new key (for a new value), or just overwrite the already //
'// created key's (if the key already exists) value in .Item, which //
'// inour case, is left empty, as we are just using the .Key to //
'// create a unique list. //
For n = LBound(aryValues, 1) To UBound(aryValues, 1)
DIC.Item(aryValues(n, 1)) = Empty
Next

'// .Keys is a 1-dimensional array, so Transpose to chunk into .List//
Me.ComboBox1.List = Application.Transpose(DIC.Keys)
End If
End With
End Sub

In a Standad Module:

Function RangeFound(SearchRange As Range, _
Optional ByVal FindWhat As String = "*", _
Optional StartingAfter As Range, _
Optional LookAtTextOrFormula As XlFindLookIn = xlValues, _
Optional LookAtWholeOrPart As XlLookAt = xlPart, _
Optional SearchRowCol As XlSearchOrder = xlByRows, _
Optional SearchUpDn As XlSearchDirection = xlPrevious, _
Optional bMatchCase As Boolean = False) As Range

If StartingAfter Is Nothing Then
Set StartingAfter = SearchRange(1)
End If

Set RangeFound = SearchRange.Find(What:=FindWhat, _
After:=StartingAfter, _
LookIn:=LookAtTextOrFormula, _
LookAt:=LookAtWholeOrPart, _
SearchOrder:=SearchRowCol, _
SearchDirection:=SearchUpDn, _
MatchCase:=bMatchCase)
End Function
Hope that helps,

Mark

[snb]

This suffices:

Private Sub UserForm_Initialize()
ComboBox1.List = Filter([transpose(if(countif(offset(C2,,,row(1:300)),C2:C300)=1,C2:C300))], "False", False)
End Sub

You can adapt the range to 3000 if necessary.

In your case:


Private Sub UserForm_Initialize()
TeamDrop.List =Filter([transpose(if(countif(offset(scoring!C2,,,row(1:3000)),scoring!C2:C3000)=1,s coring!C2:C3000))], "False", False)
End Sub





PS.
.clear is redundant


.listindex=-1 is redundant

[Kenneth Hobs]

Typically, I might use a collection or dictionary object method in a function.

Since I like reusable functions, I worked up a solution using snb's Filter method. As typical in some of my solutions, I left it to the user to insure that a proper value is sent to the function.

Private Sub UserForm_Initialize()
ComboBox1.List = NoDupCol(Worksheets("Scoring").Range("C2", _
Worksheets("Scoring").Range("C" & Rows.Count).End(xlUp)))
End Sub

Function NoDupCol(aRange As Range) As Variant
Dim w As Worksheet, s As String, q As String
Set w = aRange.Worksheet
q = """"
s = "'" & w.Name & "'!" & aRange.Address(False, False)
s = "=Transpose(If(CountIf(Offset(" & "'" & w.Name & "'!" & aRange(1).Address(False, False) & _
",,,Row(1:" & aRange.Rows.Count & "))," & s & ")=1," & s & "))"
NoDupCol = Filter(Evaluate(s), False, False)
End Function

[snb]

@KH

Thank you for taking an interest in the method I suggested.

some observations:

- you use set w=arange.worksheet and w.name , although you could have used arange.parent.name (no need to create an extra object variable)
- in
s = "=Transpose(If(CountIf(Offset(" & "'" & w.Name & "'!" & aRange(1).Address(False, False) & ",,,Row(1:" & aRange.Rows.Count & "))," & s & ")=1," & s & "))"
you forgot(?) to substitute a string by variable s
s = "=Transpose(If(CountIf(Offset(s & ",,,Row(1:" & aRange.Rows.Count & "))," & s & ")=1," & s & "))"
- I'm rather intrigued by your variable 'q' ;)

Since I have a preference for avoiding variables if they are not absolutely required or evidently beneficial I reworked your function.
Another personal preference is to use 'cells' instead of 'ranges' when numbers come in.

Private Sub UserForm_Initialize()
ComboBox1.List = NoDupCol(Sheets(1).Cells(2, 3).Resize(Sheets(1).Cells(Rows.Count, 3).End(xlUp).Row))
End Sub

Function NoDupCol(aRange As Range) As Variant
NoDupCol = Filter(Evaluate(Replace("Transpose(If(CountIf(Offset(~,,,Row(1:" & aRange.Rows.Count & ")),~)=1,~))", "~", "'" & aRange.Parent.Name & "'!" & aRange.Address(False, False))), False, False)
End Function

[snb]

Generally I prefer the bracketed [ ] evaluate method because of it's readability compared to the 'string' version of evaluate.

So I came up with:


Private Sub UserForm_Initialize()
Sheets(1).Cells(2, 3).Resize(Sheets(1).Cells(Rows.Count, 3).End(xlUp).Row).Name = "snb_"

ComboBox1.List = Filter([transpose(if(countif(offset(snb_,,,row(offset(snb_,1-row(snb_),0))),snb_)=1,snb_))], False, False)
End Sub


- you can't pass a variable to the bracketed Evaluate method
- to inform the method what range is involved we produce the object 'name' that can be evaluated by the bracketed method.
- since changing the Excel environment in a function can produce unexpected results we refrain from using a function here.

[mikerickson]

This will both alphabetize and remove duplicates.


Dim dataRange As Range, oneCell As Range
Dim i As Long
With Sheet1.Range("A:A")
Set dataRange = Range(.Cells(1, 1), .Cells(Rows.Count, 1).End(xlUp))
End With

With ComboBox1
For Each oneCell In dataRange

For i = 0 To .ListCount - 1
If oneCell.Value < .List(i) Then
GoTo PlaceItem
ElseIf oneCell.Value = .List(i) Then
GoTo NextCell
End If
Next i
PlaceItem:
.AddItem oneCell.Value, i
NextCell:
Next oneCell
End With