Combobox

AllenL

Board Regular
Joined
Mar 14, 2002
Messages
67
Hello
I am trying to create a combobox that has a list of data in a column that elimate the duplicated data and sort them.
I have a code(from the website) that creates very similar function I need. The only differences is that it uses listbox and not combobox. Then I try to modify it to combobox but I can't get it to work
The following is the code for the web:
Sub SortAndRemoveDupes()
Dim rListSort As Range, rOldList As Range
Dim strRowSource As String

'Clear Hidden sheet Column A ready for list
Sheet1.Range("A1", Sheet1.Range("A65536").End(xlUp)).Clear


'Set range variable to list we want
Set rOldList = Sheet2.Range("A1", Sheet2.Range("A65536").End(xlUp))

'Use AdvancedFilter to copy the list to Column A _
of the hidden sheet and remove all dupes
rOldList.AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=Sheet1.Cells(1, 1), Unique:=True

'Set range variable to the new non dupe list
Set rListSort = Sheet1.Range("A1", Sheet1.Range("A65536").End(xlUp))

With rListSort
'Sort the new non dupe list
.Sort Key1:=.Cells(2, 1), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
End With

'Parse the address of the sorted unique items
strRowSource = Sheet1.Name & "!" & Sheet1.Range _
("A2", Sheet1.Range("A65536").End(xlUp)).Address

Sheet1.Range("A1") = "New Sorted Unique List"
With UserForm1.ListBox1
'Clear old ListBox RowSource
.RowSource = vbNullString
'Parse new one
.RowSource = strRowSource
End With

End Sub







This is the code after I modified:

Sub SortAndRemoveDupes()
Dim rListSort As Range, rOldList As Range
Dim strRowSource As String

'Clear Hidden sheet Column A ready for list



'Set range variable to list we want
Set rOldList = Columns(2)

'Use AdvancedFilter to copy the list to Column A _
of the hidden sheet and remove all dupes
rOldList.AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=Cells(1, 2), Unique:=True

'Set range variable to the new non dupe list
Set rListSort = Columns(2)

With rListSort
'Sort the new non dupe list
.Sort Key1:=.Cells(2, 2), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
End With

'Parse the address of the sorted unique items
strRowSource = Columns(2).Address
MsgBox "StrRowSource" & strRowSource

With UserForm1.txtWeight

'Clear old ListBox RowSource
.RowSource = vbNullString
'Parse new one
.RowSource = strRowSource
'.AddItem = strRowSource

End With

End Sub


Can someone please help

Thanks in advance
 
Hello
I got an error on the line below

.RowSource = strRowSource
I tried to solve this problem by using
.AddItem = strRowSource
However, I got the same error
Can anyone help me out
Thanks in advance

The following is my new modified code:





Sub SortAndRemoveDupes()
Dim rListSort As Range, rOldList As Range
Dim strRowSource As String

'Clear Hidden sheet Column A ready for list
Sheet1.Range("A1", Sheet1.Range("A65536").End(xlUp)).Clear



'Set range variable to list we want
Set rOldList = Columns(2)

'Use AdvancedFilter to copy the list to Column A _
of the hidden sheet and remove all dupes
rOldList.AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=Sheet1.Cells(1, 1), Unique:=True



'Set range variable to the new non dupe list
Set rListSort = Sheet1.Range("A1", Sheet1.Range("A65536").End(xlUp))

With rListSort
'Sort the new non dupe list
.Sort Key1:=.Cells(2, 1), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
End With


'Parse the address of the sorted unique items
strRowSource = Sheet1.Name & "!" & Sheet1.Range _
("A2", Sheet1.Range("A65536").End(xlUp)).Address
Sheet1.Range("A1") = "New Sorted Unique List"
With UserForm1.txtWeight

'Clear old ListBox RowSource
.RowSource = vbNullString
'Parse new one
.RowSource = strRowSource
'.AddItem = strRowSource

End With




End Sub
 
Upvote 0

Excel Facts

Which Excel functions can ignore hidden rows?
The SUBTOTAL and AGGREGATE functions ignore hidden rows. AGGREGATE can also exclude error cells and more.
This worked for me

Sub SortAndRemoveDupes()
Dim rListSort As Range, rOldList As Range
Dim strRowSource As String

'Clear Hidden sheet Column A ready for list
Sheet1.Range("A1", Sheet1.Range("A65536").End(xlUp)).Clear

'Set range variable to list we want
Set rOldList = Columns(2)

'Use AdvancedFilter to copy the list to Column A _
of the hidden sheet and remove all dupes
rOldList.AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=Sheet1.Cells(1, 1), Unique:=True

'Set range variable to the new non dupe list
Set rListSort = Sheet1.Range("A1", Sheet1.Range("A65536").End(xlUp))

With rListSort
'Sort the new non dupe list
.Sort Key1:=.Cells(1, 1), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
End With


'Parse the address of the sorted unique items
strRowSource = Sheet1.Name & "!" & Sheet1.Range _
("a2", Sheet1.Range("a65536").End(xlUp)).Address
Sheet1.Range("A1") = "New Sorted Unique List"
With UserForm1.txtWeight
'Clear old ListBox RowSource
.RowSource = vbNullString
'Parse new one
.RowSource = strRowSource
'.AddItem = strRowSource
End With

End Sub

Private Sub UserForm_Initialize()
SortAndRemoveDupes
End Sub
 
Upvote 0
Really, howcome I keeps getting an error on line
.RowSource = strRowSource
can someone please help
Thanks in advance
 
Upvote 0
Hi Allen

I have code this for you from the Workbook you sent and all works as expected. You should however ommit the dashed lines in your lists as these also get pulled in.If you do wish to leave them in a simple "Edit Replace" Method could be run before the Sort taks place.

The code is longer that it really needs to be (still very quick),but I didn't want to cofuse the isssue for you by placing in a few loops.

I have also coded it so that you can simply run the Procedure at anytime the USerform is active, just in case you need to. Here is the code.


Sub SortAndRemoveDupes()
Dim rListSort1 As Range, rOldList1 As Range
Dim rListSort2 As Range, rOldList2 As Range
Dim rListSort3 As Range, rOldList3 As Range
Dim rListSort4 As Range, rOldList4 As Range

Dim strRowSource1 As String
Dim strRowSource2 As String
Dim strRowSource3 As String
Dim strRowSource4 As String


'Clear Hidden sheet Column A ready for list
Sheet3.UsedRange.Clear


'Set range variable to list we want
Set rOldList1 = Sheet2.Range("B1", Sheet2.Range("B65536").End(xlUp))
Set rOldList2 = Sheet2.Range("C1", Sheet2.Range("C65536").End(xlUp))
Set rOldList3 = Sheet2.Range("D1", Sheet2.Range("D65536").End(xlUp))
Set rOldList4 = Sheet2.Range("G1", Sheet2.Range("G65536").End(xlUp))

'Use AdvancedFilter to copy the list to Column A _
of the hidden sheet and remove all dupes
rOldList1.AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=Sheet3.Cells(1, 1), Unique:=True
rOldList2.AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=Sheet3.Cells(1, 2), Unique:=True
rOldList3.AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=Sheet3.Cells(1, 3), Unique:=True
rOldList4.AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=Sheet3.Cells(1, 4), Unique:=True

'Set range variable to the new non dupe list
Set rListSort1 = Sheet3.Range("A1", Sheet3.Range("A65536").End(xlUp))
Set rListSort2 = Sheet3.Range("B1", Sheet3.Range("B65536").End(xlUp))
Set rListSort3 = Sheet3.Range("C1", Sheet3.Range("C65536").End(xlUp))
Set rListSort4 = Sheet3.Range("D1", Sheet3.Range("D65536").End(xlUp))


With rListSort1
'Sort the new non dupe list
.Sort Key1:=.Cells(2, 1), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
End With
With rListSort2
'Sort the new non dupe list
.Sort Key1:=.Cells(2, 1), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
End With
With rListSort3
'Sort the new non dupe list
.Sort Key1:=.Cells(2, 1), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
End With
With rListSort4
'Sort the new non dupe list
.Sort Key1:=.Cells(2, 1), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
End With

'Parse the address of the sorted unique items
strRowSource1 = Sheet3.Name & "!" & Sheet3.Range _
("A2", Sheet3.Range("A65536").End(xlUp)).Address

strRowSource2 = Sheet3.Name & "!" & Sheet3.Range _
("B2", Sheet3.Range("B65536").End(xlUp)).Address

strRowSource3 = Sheet3.Name & "!" & Sheet3.Range _
("C2", Sheet3.Range("C65536").End(xlUp)).Address

strRowSource4 = Sheet3.Name & "!" & Sheet3.Range _
("D2", Sheet3.Range("D65536").End(xlUp)).Address



With UserForm1
'Clear old ListBox RowSource
.txtWeight.RowSource = vbNullString
.txtColour.RowSource = vbNullString
.txtCode.RowSource = vbNullString
.txtGrade.RowSource = vbNullString
'Parse new one
.txtWeight.RowSource = strRowSource1
.txtColour.RowSource = strRowSource2
.txtCode.RowSource = strRowSource3
.txtGrade.RowSource = strRowSource4

End With

End Sub
 
Upvote 0

Forum statistics

Threads
1,213,544
Messages
6,114,249
Members
448,556
Latest member
peterhess2002

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top