PDA

View Full Version : Solved: 2 dimensional dictionary object



lifeson
06-11-2008, 04:00 AM
I use this bit of code to create a unique list of duplicate items to use in a single column combo box and it works fine.

Set d = CreateObject("Scripting.Dictionary")
Set MakeList = wsQuery.Range("D2", "D" & lrow)

'Create list of unique items using a Dictionary object
For Each It In MakeList
d.Add It.Value, It.Value 'Add keys and items
Next
'Create an array of unique items
a = d.Items
'Sort the array
Call BubbleSort(a)
'Add the items to the combobox
Me.cboCompType.list() = a

However I want make the combo contain 2 columns

The list would be:
Set d = CreateObject("Scripting.Dictionary")
Set MakeList = wsQuery.Range("D2", "E" & lrow)


How do amend the rest to make items fit 2 columns in the combo box where all the items from column D would be in the first column and items from column E would be in the first?

Charlize
06-11-2008, 04:50 AM
?Set MakeList = wsQuery.Range("D2", "D" & lrow)
'... other code
For Each It In MakeList
d.Add It.Value & " - " & It.Offset(0, 1).Value, It.Value 'Add keys and items
Next ItCharlize

lifeson
06-11-2008, 05:15 AM
Thanks for the response Charlize

But that has not solved my problem.

It gets both the values from colum D and Column E but puts them both in the first column e.g.

Column D value 1
Column E value 1
Column D value 2
Column E value 2
etc...


(I have checked to ensure the combo has 2 columns)

lifeson
06-11-2008, 11:14 PM
Attached is an example spreadsheet


The routine should search colum C and make a list of unique items including the matching item from column D and then sort them alphabeticall then display results in a two column combo box

mdmackillop
06-11-2008, 11:33 PM
Private Sub Populate_cboCompType()
Dim i As Long, lrow As Long
Dim MakeList As Range
Dim cel As Range
Dim d As Variant, It As Variant, a As Variant
Dim arr()
Dim ws As Worksheet

Set ws = ThisWorkbook.Worksheets("Data")
On Error Resume Next

lrow = ws.Cells(Rows.Count, "A").End(xlUp).Row
If lrow = 2 Then
Me.cboCompType.Value = ws.Cells(2, "C").Value
Me.txtTypeDescription.Value = ws.Cells(2, "D").Value
Else
'build a list of component types available
Set d = CreateObject("Scripting.Dictionary")
Set MakeList = ws.Range("C2", "C" & lrow)

'Create list of unique items using a Dictionary object
For Each It In MakeList
d.Add It.Value, It.Value 'Add keys and items
Next
'Create an array of unique items
a = d.items
'Sort the array
Call BubbleSort(a)

'Create new array with corresponding values
i = 0
ReDim arr(d.Count, 1)
For Each It In a
arr(i, 0) = It
arr(i, 1) = Columns(3).Find(It).Offset(, 1).Value
i = i + 1
Next

'Add the items to the combobox
Me.cboCompType.list() = arr
End If
End Sub

lifeson
06-12-2008, 12:00 AM
Thanks MDM I can see what you are attempting

'Create new array with corresponding values
i = 0
ReDim arr(d.Count, 1)
For Each It In a
arr(i, 0) = It
arr(i, 1) = Columns(3).Find(It).Offset(, 1).Value
i = i + 1
Next



but it still only give me a single column in the combo box

lifeson
06-12-2008, 12:07 AM
Ha! just sussed it
arr(i, 1) = Columns(3).Find(It).Offset(, 1).Value
Change to
arr(i, 1) = ws.Columns(3).Find(It).Offset(, 1).Value

mdmackillop
06-12-2008, 12:13 AM
Try changing the Find code as follows

arr(i, 1) = Sheets("Data").Columns(3).Find(What:=It, LookIn:=xlFormulas, _
LookAt:=xlWhole, MatchCase:=False).Offset(, 1).Value