Combobox

[AllenL]

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

[AllenL]

Anyone HELP!!!

[Ivan F Moala]

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

[AllenL]

Really, howcome I keeps getting an error on line
.RowSource = strRowSource
can someone please help
Thanks in advance

[Dave Hawley]

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