Solved: Problem with ListBox

[Rayman]

With reference to my previous post, can someone tell me why this code fill only the first column of ListBox (Lst1 in the code) and not the column 2 too??
[vba]
Private Sub UserForm_Initialize()
Dim col As Collection, col2 As Collection
Dim v As Variant, v2 As Variant
Dim sht As Worksheet
Dim lng As Long
Set col = New Collection
Set col2 = New Collection
Set sht = ActiveSheet
On Error Resume Next
With ActiveSheet
For lng = 4 To 500
If Cells(lng, 6) <> "" Then
col.Add .Cells(lng, 6).Value, _
CStr(.Cells(lng, 6).Value)

If Cells(lng, 7) <> "" Then
col2.Add .Cells(lng, 7).Value, _
CStr(.Cells(lng, 7).Value)
End If
End If
Next
End With
With Me.Lst1
Lst1.Clear

For Each v In col
Lst1.AddItem v
Next
For Each v2 In col2
Lst1.Column(2).AddItem v2
Next
End With
Set col = Nothing
Set col2 = Nothing
Set sht = Nothing
End Sub
[/VBA]

Thanks in advance

[Aflatoon]

You cannot use Additem on a specific column - you should populate the second column as you add the first:
[vba]

Private Sub UserForm_Initialize()
Dim col As Collection
Dim col2 As Collection
Dim sht As Worksheet
Dim lng As Long
Dim n As Long

Set col = New Collection
Set col2 = New Collection

Set sht = ActiveSheet

On Error Resume Next
With ActiveSheet
For lng = 4 To 500
If Cells(lng, 6) <> "" Then
col.Add .Cells(lng, 6).Value, _
CStr(.Cells(lng, 6).Value)

If Cells(lng, 7) <> "" Then
col2.Add .Cells(lng, 7).Value, _
CStr(.Cells(lng, 7).Value)
End If
End If
Next
End With
On Error GoTo 0

With Me.Lst1
.Clear

For n = 1 To col.Count
.AddItem col(n)
.List(.ListCount - 1, 1) = col2(n)
Next n

End With
Set col = Nothing
Set col2 = Nothing
Set sht = Nothing
End Sub
[/vba]

Note: with the way you populate your collections, it is possible for your data to be mismatched compared to the way it appeared in the worksheet. I do not know if this is an issue for you.

[Rayman]

You cannot use Additem on a specific column - you should populate the second column as you add the first:
[vba]

Private Sub UserForm_Initialize()
Dim col As Collection
Dim col2 As Collection
Dim sht As Worksheet
Dim lng As Long
Dim n As Long

Set col = New Collection
Set col2 = New Collection

Set sht = ActiveSheet

On Error Resume Next
With ActiveSheet
For lng = 4 To 500
If Cells(lng, 6) <> "" Then
col.Add .Cells(lng, 6).Value, _
CStr(.Cells(lng, 6).Value)

If Cells(lng, 7) <> "" Then
col2.Add .Cells(lng, 7).Value, _
CStr(.Cells(lng, 7).Value)
End If
End If
Next
End With
On Error GoTo 0

With Me.Lst1
.Clear

For n = 1 To col.Count
.AddItem col(n)
.List(.ListCount - 1, 1) = col2(n)
Next n

End With
Set col = Nothing
Set col2 = Nothing
Set sht = Nothing
End Sub
[/vba]

Note: with the way you populate your collections, it is possible for your data to be mismatched compared to the way it appeared in the worksheet. I do not know if this is an issue for you.

Many thanks Aflatoon, your code works well, but you are right , my data are mismatched compare to the way it appeares in my worksheet

In case you have time , i reattached my example file so you can understand what I would like to do and can help me if you like.

Have a good day

[Aflatoon]

What is the logic supposed to be? Do you populate all rows as long as either column 6 or 7 is populated? Or do they both have to be populated? And, assuming you are using a collection to get unique entries, do they need to be unique on a combination of both columns?

[Aflatoon]

I think I can see what it is you want - does this come close:
[vba]Private Sub UserForm_Initialize()
Dim col As Object
Dim sht As Worksheet
Dim lng As Long
Dim n As Long
Dim vardata As Variant
Dim varKeys As Variant
Dim varItems As Variant
Dim strKey As String

Set sht = ActiveSheet

Set col = CreateObject("Scripting.Dictionary")

With sht
For lng = 4 To 500
If .Cells(lng, 8) <> "" Then
strKey = .Cells(lng, 6).Value & ":" & .Cells(lng, 7).Value
If col.exists(strKey) Then
col(strKey) = col(strKey) + .Cells(lng, 8).Value
Else
col(strKey) = .Cells(lng, 8).Value
End If
End If
Next lng
End With

With Me.Lst1
.Clear
varKeys = col.keys
varItems = col.items
For n = LBound(varKeys) To UBound(varKeys)
vardata = Split(varKeys(n), ":")
.AddItem vardata(0)
.List(.ListCount - 1, 1) = vardata(1)
.List(.ListCount - 1, 2) = varItems(n)
Next n

End With
Set col = Nothing
Set sht = Nothing
End Sub
[/vba]

[Rayman]

I think I can see what it is you want - does this come close:
[vba]Private Sub UserForm_Initialize()
Dim col As Object
Dim sht As Worksheet
Dim lng As Long
Dim n As Long
Dim vardata As Variant
Dim varKeys As Variant
Dim varItems As Variant
Dim strKey As String

Set sht = ActiveSheet

Set col = CreateObject("Scripting.Dictionary")

With sht
For lng = 4 To 500
If .Cells(lng, 8) <> "" Then
strKey = .Cells(lng, 6).Value & ":" & .Cells(lng, 7).Value
If col.exists(strKey) Then
col(strKey) = col(strKey) + .Cells(lng, 8).Value
Else
col(strKey) = .Cells(lng, 8).Value
End If
End If
Next lng
End With

With Me.Lst1
.Clear
varKeys = col.keys
varItems = col.items
For n = LBound(varKeys) To UBound(varKeys)
vardata = Split(varKeys(n), ":")
.AddItem vardata(0)
.List(.ListCount - 1, 1) = vardata(1)
.List(.ListCount - 1, 2) = varItems(n)
Next n

End With
Set col = Nothing
Set sht = Nothing
End Sub
[/vba]

Wow Aflatoon
I would never be able to do it alone, great coding, i think you are a GENIUS.

Many thanks