Populating List Box 1

[meldrape]

I will preface this with the fact I am not very proficient with Excel. I use Access occassionally.

Now, is there a way I can populate a list box from a spreadsheet, but use every sixth line, i.e. A1, A6, A12 until there are no more entries? Here's what I have:

I am importing a text file. The names and addresses are not split up but each 6th line starts a new record. I only need the name in the list box so the user can make choose from a list of customers.

Any thoughts would be greatly appreciated. Here's the code I am using as an example. Thanks in advance.

Sub PopulateListWithUniqueItems()
Dim anyR As Range
Dim listCollection As New Collection
Dim cMember
Dim I As Integer
Dim J As Integer
Dim lCount As Integer
Dim cell As Range
Dim tempS
Dim myList()
'in this example, the entries are assumed to be in
'cells A1 to A20.
Set anyR = Range("=Customers!A1:A20&quot


'on error must be set as an error is created
'when a duplicate item is added to the listCollection
'and we want the macro to continue
On Error Resume Next
For Each cell In anyR
If Not IsEmpty(cell) Then
'second argument as shown is needed
listCollection.Add cell.Value, CStr(cell.Value)
End If

Next
'turn off error handling
On Error GoTo 0

'assign to a list for easier use
lCount = listCollection.Count
ReDim myList(1 To lCount)
For Each cMember In listCollection
I = I + 1
myList(I) = cMember
Next

'sort the list
For I = 1 To lCount - 1
For J = I + 1 To lCount

If myList(I) > myList(J) Then
tempS = myList(I)
myList(I) = myList(J)
myList(J) = tempS
End If
Next
Next
'assign to listbox
UserForm1.ListBox1.List = myList
'display form
UserForm1.Show
End Sub

 

[rmikesmith]

Meldrape,

Here is your procedure modified to pick out every 6th row for inclusion in the the ListBox:

Sub PopulateListWithUniqueItems()
    Dim listCollection As New Collection
    Dim cMember
    Dim I As Integer
    Dim J As Integer
    Dim lCount As Integer
    Dim cell As Range
    Dim tempS
    Dim myList()
    Dim LastUsedRow As Long
    Dim wks As Worksheet
    
    On Error Resume Next
    
    Set wks = ThisWorkbook.Worksheets("Customers")
    With wks
      LastUsedRow = .Cells(65536, 1).End(xlUp).Row
    
      For I = 1 To LastUsedRow Step 5
        If Not IsEmpty(.Cells(I, 1)) Then
          listCollection.Add .Cells(I, 1).Value, CStr(.Cells(I, 1).Value)
        End If
      Next I
    End With

    On Error GoTo 0
    
    lCount = listCollection.Count
    ReDim myList(1 To lCount)
    I = 0
    For Each cMember In listCollection
        I = I + 1
        myList(I) = cMember
    Next
    For I = 1 To lCount - 1
        For J = I + 1 To lCount

            If myList(I) > myList(J) Then
                tempS = myList(I)
                myList(I) = myList(J)
                myList(J) = tempS
            End If
        Next
    Next
    UserForm1.ListBox1.List = myList
    UserForm1.Show
End Sub

Note: This will determine the end of the data (in column A) at run-time.

P.S. This is the first posting I've seen that uses the Collection object to generate unique items in a ListBox; a slick technique that John Walkenbach has posted code for on his website.


HTH
Mike

 

[HobbitK]

rmikesmith ...
Do youhave a link to the site you referenced in your post?
I would like to see that site.
Michael

 

[meldrape]

Thanks rmikesmith, works like a charm. Hobbitk asked a great question. If you have that site address please post. Many thanks again!!

 

[rmikesmith]

Hello All,

Here is the address to the specific page on Walkenbach's site that covers the topic:

http://www.j-walk.com/ss/excel/tips/tip47.htm

This is a great site with lots of other tips. You can also fritter away any unused time perusing John's weblog.


Regards,
Mike

 

[meldrape]

That's a great site and I've only scratched the surface. many thanks.