I am having trouble adding a 3 column list to a combo box, I am first removing all duplicates and then sorting the list then saving to an array. I would then like to add the next two columns of the list to the array to match the original list. Is there an easier way to do this?

Required:
combo box with three columns retrieved from spreadsheet
sorted with no duplicates

Thanks in advance for your great help.

Here is what I have so far


Private Sub RemoveDuplicates(ByVal strlstType As String, NoDupes As Collection)

Dim AllCells As Range, Cell As Range
Dim I As Integer, j As Integer
Dim Swap1, Swap2, Item
Dim data(1 To 40, 1 To 3) As String
Dim intLoopCount As Integer
Dim strStyle, strStyleName, strPriceGroup As String


If strlstType = "Styles" Then
Set AllCells = Range("A2:A3270")
ElseIf strlstType = "StyleNames" Then
Set AllCells = Range("B2:B3270")
End If

' The next statement ignores the error caused
' by attempting to add a duplicate key to the collection.
' The duplicate is not added - which is just what we want!
On Error Resume Next
For Each Cell In AllCells
NoDupes.Add Cell.Value, CStr(Cell.Value)
' Note: the 2nd argument (key) for the Add method must be a string
Next Cell

' Resume normal error handling
On Error GoTo 0

' Sort the collection (optional)
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, befo=j
NoDupes.Add Swap2, befo=I
NoDupes.Remove I + 1
NoDupes.Remove j + 1
End If
Next j
Next I

'Add the sorted, non-duplicated items to an array called data
I = 1
j = NoDupes.Count

For Each Item In NoDupes
If strlstType = "Styles" Then
data(I, 1) = Item
'Ok, here is the problem I would like to go back to the original list and add
'the data from the next two columns into the sorted and not duplicates
strStyle = Item
MsgBox strStyle
' strStyleName
' strPriceGroup


End If
I = I + 1
Next Item
'Now that all the items styles are in the array,
'Add the style name and price group


frmDealerOrder.cboUpperFrontsStyleCode.List = data()

Sub TestDups()
Dim NoDupes As New Collection
Dim strLstType As String
strLstType = "Styles"
RemoveDuplicates strLstType, NoDupes
End Sub

Private Sub RemoveDuplicates(ByVal strLstType _
As String, NoDupes As Collection)

Dim AllCells As Range, Cell As Range
Dim I As Integer, j As Integer
Dim Swap1, Swap2, Item
Dim data(1 To 40, 1 To 3) As String
Dim intLoopCount As Integer
Dim strStyle, strStyleName, strPriceGroup As String
Dim varr(1 To 3)


If strLstType = "Styles" Then
Set AllCells = Range("A2:A3270")
ElseIf strLstType = "StyleNames" Then
Set AllCells = Range("B2:B3270")
End If

' The next statement ignores the error caused
' by attempting to add a duplicate key to the collection.
' The duplicate is not added - which is just what we want!
On Error Resume Next
For Each Cell In AllCells
If strLstType = "Styles" Then
varr(1) = Cell.Value
varr(2) = Cell.Offset(0, 1).Value
varr(3) = Cell.Offset(0, 2).Value
Else
varr(1) = Cell.Value
varr(2) = Cell.Offset(0, -1)
varr(3) = Cell.Offset(0, 1).Value
End If
NoDupes.Add varr, CStr(Cell.Value)
' Note: the 2nd argument (key) for the Add method must be a string
Next Cell

' Resume normal error handling
On Error GoTo 0

' Sort the collection (optional)
For I = 1 To NoDupes.Count - 1
For j = I + 1 To NoDupes.Count
Debug.Print I, NoDupes(I)(1), j; NoDupes(j)(1)
If NoDupes(I)(1) NoDupes(j)(1) Then
Swap1 = NoDupes(I)
Swap2 = NoDupes(j)
NoDupes.Add Swap1, befo=j
NoDupes.Add Swap2, befo=I
NoDupes.Remove I + 1
NoDupes.Remove j + 1
End If
Next j
Next I

'Add the sorted, non-duplicated items to an array called data
I = 1
j = NoDupes.Count

For Each Item In NoDupes
If strLstType = "Styles" Then
data(I, 1) = Item(1)
data(I, 2) = Item(2)
data(I, 3) = Item(3)
Else
data(I, 1) = Item(2)
data(I, 2) = Item(1)
data(I, 3) = Item(3)
End If
I = I + 1
Next Item
'Now that all the items styles are in the array,
'Add the style name and price group


frmDealerOrder.cboUpperFrontsStyleCode.List = data()


End Sub


--
Regards,
Tom Ogilvy



"John" wrote in message
...
I am having trouble adding a 3 column list to a combo box, I am first
removing all duplicates and then sorting the list then saving to an array.
I would then like to add the next two columns of the list to the array to
match the original list. Is there an easier way to do this?

Required:
combo box with three columns retrieved from spreadsheet
sorted with no duplicates

Thanks in advance for your great help.

Here is what I have so far


Private Sub RemoveDuplicates(ByVal strlstType As String, NoDupes As
Collection)

Dim AllCells As Range, Cell As Range
Dim I As Integer, j As Integer
Dim Swap1, Swap2, Item
Dim data(1 To 40, 1 To 3) As String
Dim intLoopCount As Integer
Dim strStyle, strStyleName, strPriceGroup As String


If strlstType = "Styles" Then
Set AllCells = Range("A2:A3270")
ElseIf strlstType = "StyleNames" Then
Set AllCells = Range("B2:B3270")
End If

' The next statement ignores the error caused
' by attempting to add a duplicate key to the collection.
' The duplicate is not added - which is just what we want!
On Error Resume Next
For Each Cell In AllCells
NoDupes.Add Cell.Value, CStr(Cell.Value)
' Note: the 2nd argument (key) for the Add method must be a string
Next Cell

' Resume normal error handling
On Error GoTo 0

' Sort the collection (optional)
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, befo=j
NoDupes.Add Swap2, befo=I
NoDupes.Remove I + 1
NoDupes.Remove j + 1
End If
Next j
Next I

'Add the sorted, non-duplicated items to an array called data
I = 1
j = NoDupes.Count

For Each Item In NoDupes
If strlstType = "Styles" Then
data(I, 1) = Item
'Ok, here is the problem I would like to go back to the
original list and add
'the data from the next two columns into the sorted and not
duplicates
strStyle = Item
MsgBox strStyle
' strStyleName
' strPriceGroup


End If
I = I + 1
Next Item
'Now that all the items styles are in the array,
'Add the style name and price group


frmDealerOrder.cboUpperFrontsStyleCode.List = data()