If it's just a display problem (not the correct width), you can change the
..columnwidths (either manually in the VBE--click on the listbox, hit F4 to see
the properties and enter 20;30;50 in the .columnwidths property--adjust as
required.)

or in code:

Me.ListBox1.ColumnCount = 3
Me.listbox1.columnwidths = "20;30;50"

(For me, it's usually a matter of trial and error to get those widths correct.)

Look at help for more info.

And this section would change, too:

With Me.ListBox1
.AddItem mySplit(LBound(mySplit))
.list(.listcount - 1, 1) = mysplit(lbound(mysplit)+1)
.List(.ListCount - 1, 2) = mySplit(UBound(mySplit))
End With


tjh wrote:

Thanks Dave,

Rather than using the filter option, I set the second column to appear
first. I found this would work fine for this purpose. However, I also
realized that I need a third column. You will notice that I altered the
NoDups.Add line to accomodate this list, but the columns are not spacing
correctly. Any suggestions? Thanks

Me.ListBox1.ColumnCount = 3

With ActiveSheet
Set AllCells = .Range("O1", .Cells(.Rows.Count, "O").End(xlUp))
End With

On Error Resume Next
For Each Cell In AllCells
myStr = Cell.Value If Cell.Value = 0 _
Or UCase(Cell.Value) = "SPC" _
Or UCase(Cell.Offset(0, -7).Value) = "TBD" _
Or Cell.Value = "" _
Or myStr = Chr(1) Then
'do nothing
Else
NoDupes.Add Cell.Offset(0, -14).Value & " " & Cell.Offset(0, -7).Value &
Chr(1) & myStr, CStr(myStr)
End If

"Dave Peterson" wrote:

I think I'd just use data|Filter|advanced filter|unique records only and then
cycle through those cells.

But this means there has to be a header in the column O. (Is that what SPC
represented?)

If you don't have a header row, either add one manually insert a new row at the
top, add your header and delete that row when you're done building the listbox
list.

Option Explicit
Private Sub CommandButton1_Click()
Unload Me
End Sub
Private Sub UserForm_Initialize()

Dim myRng As Range 'original range
Dim myFRng As Range 'filtered range
Dim myCell As Range

Me.ListBox1.ColumnCount = 2

With ActiveSheet
Set myRng = .Range("O1", .Cells(.Rows.Count, "O").End(xlUp))
With myRng
.AdvancedFilter Action:=xlFilterInPlace, Unique:=True
Set myFRng = Nothing
On Error Resume Next
Set myFRng = .Resize(.Rows.Count - 1, 1) _
.Offset(1, 0).Cells.SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If myFRng Is Nothing Then
MsgBox "no data!"
Exit Sub
End If
End With

.ShowAllData 'remove the advanced filter.

For Each myCell In myFRng.Cells
If myCell.Value = 0 _
Or UCase(myCell.Value) = "SPC" _
Or myCell.Value = "" Then
'do nothing
Else
With Me.ListBox1
.AddItem myCell.Value
.List(.ListCount - 1, 1) = myCell.Offset(0, -6).Value
End With
End If
Next myCell
End With

End Sub

tjh wrote:

Thank you for your response. I did make the duplicate requirment a little
confusing. I am looking for no duplicates in column "O". Any suggestions?

Thanks,

"Dave Peterson" wrote:

John Walkenbach has a sample of how to fill a listbox with unique items at:
http://j-walk.com/ss/excel/tips/tip47.htm

I figured I could just join the values from the two columns, add that string to
the process to eliminate duplicates and then separate it into two when I was
done.

But I was kind of confused at your requirements, though. Can column "0" be
blank, but I not? Can I be blank, but not "O".

This portion:
If Cell.Value = 0 _
or ucase(cell.value) = "SPC" _
Or Cell.Value = "" _
Or myStr = Chr(1) Then

Can be modified to flunk out the stuff you don't want.


Option Explicit
Private Sub CommandButton1_Click()
Unload Me
End Sub
Private Sub UserForm_Initialize()

Dim AllCells As Range, Cell As Range
Dim NoDupes As New Collection
Dim i As Long, j As Long
Dim Swap1, Swap2, Item
Dim myStr As String
Dim mySplit As Variant

Me.ListBox1.ColumnCount = 2

With ActiveSheet
Set AllCells = .Range("O1", .Cells(.Rows.Count, "O").End(xlUp))
End With

On Error Resume Next
For Each Cell In AllCells
myStr = Cell.Value & Chr(1) & Cell.Offset(0, -6).Value
If Cell.Value = 0 _
or ucase(cell.value) = "SPC" _
Or Cell.Value = "" _
Or myStr = Chr(1) Then
'do nothing
Else
NoDupes.Add myStr, CStr(myStr)
End If

Next Cell
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

For Each Item In NoDupes
mySplit = Split97(CStr(Item), Chr(1))
'or if xl2k and higher
'mySplit = Split(CStr(Item), Chr(1))
With Me.ListBox1
.AddItem mySplit(LBound(mySplit))
.List(.ListCount - 1, 1) = mySplit(UBound(mySplit))
End With
Next Item

End Sub
Function Split97(sStr As String, sdelim As String) As Variant
'from Tom Ogilvy
Split97 = Evaluate("{""" & _
Application.Substitute(sStr, sdelim, """,""") & """}")
End Function


=====
Split was added in xl2k. If you're using xl97, use Tom's split97. If you and
your users are all at xl2k or higher, you can delete that function completely
and use the built in Split.

tjh wrote:

Hello,

I am trying to create a 2 column listbox using data from column "O" and
column "I" in a spreadsheet. Additionally, there are duplicate values in
these columns. I would like to remove any duplicates so the Listbox only
shows one of each value in the list. Also, no blank rows. Below is code that
I have used for one column, but I am not familiar with creating two columns
and then removing any duplicate values. Any help would be greatly
appreciated. Thank You,

Dim myRng As Range
Dim myCell As Range


With ActiveSheet
Set myRng = .Range("O1", .Cells(.Rows.Count, "O").End(xlUp))
End With

For Each myCell In myRng.Cells
If myCell.Value = 0 Or myCell.Value = "SPC" Then
Else
Me.ListBox1.AddItem myCell.Value
End If
Next myCell

--

Dave Peterson


--

Dave Peterson


--

Dave Peterson