Combo Box - Unique Values and Sort.

[LEXCERM]

Guys/Gals,

I have a combo box on a form with it's row source pointing to column 'd' of 'sheet1'.

How can I get the combo to:-
a) show unique values only (and not all the duplicate values)
b) sort the results in the combo in ascending order

Thanks in advance,
PAUL.

 

[Gettingbetter]

look at this thread

http://www.mrexcel.com/board2/viewtopic.php?t=60607&highlight=sort+combobox

Cheers

 

[LEXCERM]

Thanks GETTINGBETTER,

That is a good resolution to the sort issue, I now just need to get rid of the duplicate records.

Cheers,
PAUL.

 

[Tom Urtis]

I appreciate Gettingbetter linking to one of my posts, which spoke to the issue on that thread of sorting the ComboBox items. The below code, which goes in the userform module, will populate only unique values from column D as you asked, and then sort them in ascending order. Delete the Initialization event code you currently have and replace it with the following code. Remember to clear the RowSource property of your ComboBox first, if you have not already done so. If by chance column D contains formulas, post back...my code assumed it only contains constants.


Private Sub UserForm_Initialize()
Application.ScreenUpdating = False
Dim Coll As Collection, cell As Range
Dim unsorted As Boolean, i As Integer, temp As Variant
On Error Resume Next
Set Coll = New Collection
With ComboBox1
.Clear
For Each cell In Worksheets("Sheet1").Columns(4).SpecialCells(2)
If Len(cell) <> 0 Then
Err.Clear
Coll.Add cell.Value, cell.Value
If Err.Number = 0 Then .AddItem cell.Value
End If
Next cell
unsorted = True
Do
unsorted = False
For i = 0 To UBound(.List) - 1
If .List(i) > .List(i + 1) Then
temp = .List(i)
.List(i) = .List(i + 1)
.List(i + 1) = temp
unsorted = True
Exit For
End If
Next i
Loop While unsorted = True
.ListIndex = 0 'optional
End With
Set Coll = Nothing
Application.ScreenUpdating = True
End Sub

 

[LEXCERM]

Thanks Tom,

That's excellent! Only two minor snags:-

1) How do I change the coding so that the first cell is not included (i.e. D1) as this is the header.
2) This works well with alpha characters, buT when I try numerics or dates it doesn't populate the combo. This might be something similar to what you said regarding formulas?

Much thanks,
PAUL.

 

[Tom Urtis]

This should handle those snags:


Private Sub UserForm_Initialize()
Application.ScreenUpdating = False
Dim Coll As Collection, cell As Range, LR As Long
Dim unsorted As Boolean, i As Integer, temp As Variant
Dim SourceSheet As Worksheet
Set SourceSheet = Worksheets("Sheet1")
LR = SourceSheet.Cells(Rows.Count, 4).End(xlUp).row
On Error Resume Next
Set Coll = New Collection
With ComboBox1
.Clear
For Each cell In SourceSheet.Range("D2:D" & LR)
If Len(cell) <> 0 Then
Err.Clear
Coll.Add cell.Text, cell.Text
If Err.Number = 0 Then .AddItem cell.Text
End If
Next cell
unsorted = True
Do
unsorted = False
For i = 0 To UBound(.List) - 1
If .List(i) > .List(i + 1) Then
temp = .List(i)
.List(i) = .List(i + 1)
.List(i + 1) = temp
unsorted = True
Exit For
End If
Next i
Loop While unsorted = True
.ListIndex = 0 'optional
End With
Set Coll = Nothing
Set SourceSheet = Nothing
Application.ScreenUpdating = True
End Sub

 

[LEXCERM]

Tom, thanks very much for sticking with me on this.

Final point, however. If I have the following numbers:-

2
1
3
44
25

...the combo sorts them as:-

1
2
25
3
44

...rather than 1 2 3 25 44 (this seems to do it with dates as well).

Thanks for your time. By the way, are you the same Tom urtis who wrote HOLY MACRO!

Many thanks,
PAUL.

 

[Tom Urtis]

Yes, I am the same Tom Urtis who is one of the authors of the Holy Macros disk. In fact I am working on it today, just taking a break and perusing the message board.

Regarding your question about how the numbers are sorting, let's take a different approach...here's something I just wrote that works for me:


Private Sub UserForm_Initialize()
With Application
.ScreenUpdating = False
.DisplayAlerts = False
Dim asn As String, ItemsRange As Range, cell As Range
asn = ActiveSheet.Name
Sheets.Add
Columns(1).Value = Sheets(asn).Columns(4).Value
Columns(1).SpecialCells(4).EntireRow.Delete
Rows(1).Insert
Range("A1").Value = "zzzzz"
Set ItemsRange = Range("A1").CurrentRegion
With ItemsRange
.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlYes
.AdvancedFilter Action:=xlFilterInPlace, Unique:=True
ComboBox1.Clear
For Each cell In .Offset(1).Resize(.Rows.Count - 1, 1).SpecialCells(12)
ComboBox1.AddItem cell
Next cell
End With
ActiveSheet.Delete
Sheets(asn).Activate
Set ItemsRange = Nothing
ComboBox1.ListIndex = 0
.DisplayAlerts = True
.ScreenUpdating = True
End With
End Sub

 

[LEXCERM]

Thanks Tom, that's exactly what I required.

You've been a great help and good luck with your writing.

Cheers,
PAUL.

 

[Tom Urtis]

Thanks for the well-wishes. True I'm a little biased, but that CD of 1900 (and growing) examples is among the very best VBA compilations anywhere in my opinion. A great investment for Excel users at any level of expertise.