none
excel 2010 vba listbox results not indexing correctly RRS feed

  • Question

  • The plan was, to use listbox1 to display a list that had duplicates removed and placed in a different range(same sheet). Then when selecting the (City) in listbox1 the results would be displayed in a multicoulmn listbox2 .Basically showing all the matching assets from a range (a3:p799). The problem is while I can see my row counter changing the row data is the same for listbox2.

    I was expecting the following to show differnt results in multiple rows inside listbox 2, but its the same data.

    Private Sub ListBox1_Click()
    ListBox2.Clear
    Dim Source As String, T As String, U As String, i As Integer, _
    rngFound As Range, rngFnd2 As Range, rngFnd3 As Range, rngFnd4 As Range, cel As Range, cel2 As Range, cel3 As Range, cel4 As Range

        Source = ListBox1.Value

    Dim wks As Worksheet
        Set wks = ThisWorkbook.Worksheets("TaskDetails")
        T = wks.UsedRange.Address
    With wks
         'always better to AutoFilter than Loop when you can!
        .UsedRange.AutoFilter 12, Source 'column L, city
           Set rngFound = Intersect(.UsedRange.Resize(.UsedRange.Rows.Count - 1, .UsedRange.Columns.Count).Offset(1, 0), .Columns(3)).SpecialCells(xlCellTypeVisible)
              i = -1  'ideally this will be rngFound.Count

           If Not rngFound Is Nothing Then
             For Each cel In rngFound
             ' MsgBox ("Cel= " & cel) & Chr(13) & _
              (" Rngrw= " & rngFound.ROW) & Chr(13) & _
              (" Rngcnt= " & rngFound.Count) & Chr(13) & _
              ("Used= : " & T)
            i = i + 1
               If Not IsNumeric(cel) Then
                'Me.ListBox2.AddItem cel
                 'MsgBox ("Cel2 " & cel2 & "/ Rng " & rngFnd)
                'MsgBox (ListBox1.ListCount & "/ cnt " & ListBox1.ListIndex)
                   With ListBox2
                       'Determine number of columns
                       .ColumnCount = 5
                       'Set column widths
                       .ColumnWidths = "40,180;40,40,40"
                       .AddItem
                       .List(.ListCount - 1, 0) = wks.Range("A" & rngFound.ROW + i)
                       .List(.ListCount - 1, 1) = wks.Range("C" & rngFound.ROW + i)
                       .List(.ListCount - 1, 2) = wks.Range("B" & rngFound.ROW + i)
                       .List(.ListCount - 1, 3) = wks.Range("I" & rngFound.ROW + i)
                       .List(.ListCount - 1, 4) = wks.Range("O" & rngFound.ROW + i)
                    End With
                End If
             Next
        End If
      ' .AutoFilterMode = False
     End With
    End Sub


    heads up

    Saturday, January 17, 2015 7:57 PM

Answers

  • Does this do what you want?

    Private Sub ListBox4_Click()
        Dim Source As String, rngFound As Range, cel As Range
        Dim Wks As Worksheet
        Dim col As New Collection, itm As Variant
        On Error Resume Next
        ListBox1.Clear
        Source = ListBox4.Value
        Set Wks = ThisWorkbook.Worksheets("TaskDetails")
        With Wks
            .UsedRange.AutoFilter 7, Source 'column tech
            Set rngFound = Intersect(.UsedRange.Resize(.UsedRange.Rows.Count - 1, _
                .UsedRange.Columns.Count).Offset(1, 0), _
                .Columns(12)).SpecialCells(xlCellTypeVisible)
            If Not rngFound Is Nothing Then
                For Each cel In rngFound
                    If Not IsNumeric(cel.Value) Then
                        ' Try to add the cell value to the collection
                        ' This will fail if the same value has already been added
                        col.Add Item:=cel.Value, Key:=CStr(cel.Value)
                    End If
                Next cel
            End If
            .AutoFilterMode = False
        End With
        ' Fill the list box from the collection
        For Each itm In col
            Me.ListBox1.AddItem itm
        Next itm
    End Sub


    Regards, Hans Vogelaar (http://www.eileenslounge.com)

    Sunday, January 18, 2015 11:07 PM
  • Dude You are a Rock-Star.... Yes it does! I was able to figure out the "Sort" form there. Thanks again

    For Each itm In col
    With ListBox1
            .AddItem itm

            For i = 0 To .ListCount - 2
                For j = i + 1 To .ListCount - 1
                    If .List(i) > .List(j) Then
                        itm = .List(j)
                        .List(j) = .List(i)
                        .List(i) = itm
                    End If
                Next j
            Next i
        End With
    Next itm


    Monday, January 19, 2015 12:53 AM

All replies

  • Replace rngFound.Row with cel.Row.

    Regards, Hans Vogelaar (http://www.eileenslounge.com)

    Saturday, January 17, 2015 8:11 PM
  • Han's Thanks,

    This works great, I did need to remove the +i as well. You are a genius.


    heads up


    Saturday, January 17, 2015 9:36 PM
  • Hans is a pretty damn smart fellow!

    Knowledge is the only thing that I can give you, and still retain, and we are both better off for it.

    Sunday, January 18, 2015 1:56 AM
  • Hans,

    I was so thrilled with the last result, I decided I could include an option to filter at a higher level. But as it turns out, listbox4 which is my "optional" filter criteria now populates listbox1 but includes duplicate data which is not desired. Is there a simple tweak to remove the duplicates before I "additem listbox1" ? I found the tip, http://j-walk.com/ss/excel/tips/tip47.htm " but hacking at it, I concluded Im in over my head how to merge the two routines.

    Private Sub ListBox4_Click()
    ListBox1.Clear
    On Error Resume Next

    Dim Source As String, rngFound As Range, cel As Range
        Source = ListBox4.Value
    Dim Wks As Worksheet
        Set Wks = ThisWorkbook.Worksheets("TaskDetails")
    With Wks
             .UsedRange.AutoFilter 7, Source 'column tech
           Set rngFound = Intersect(.UsedRange.Resize(.UsedRange.Rows.Count - 1, .UsedRange.Columns.Count).Offset(1, 0), .Columns(12)).SpecialCells(xlCellTypeVisible)
            
            If Not rngFound Is Nothing Then
            For Each cel In rngFound
                If Not IsNumeric(cel) Then
                 Me.ListBox1.AddItem cel
                ' MsgBox (cel)
                End If
            Next
        End If
       .AutoFilterMode = False
     End With


    heads up

    Sunday, January 18, 2015 10:59 PM
  • Does this do what you want?

    Private Sub ListBox4_Click()
        Dim Source As String, rngFound As Range, cel As Range
        Dim Wks As Worksheet
        Dim col As New Collection, itm As Variant
        On Error Resume Next
        ListBox1.Clear
        Source = ListBox4.Value
        Set Wks = ThisWorkbook.Worksheets("TaskDetails")
        With Wks
            .UsedRange.AutoFilter 7, Source 'column tech
            Set rngFound = Intersect(.UsedRange.Resize(.UsedRange.Rows.Count - 1, _
                .UsedRange.Columns.Count).Offset(1, 0), _
                .Columns(12)).SpecialCells(xlCellTypeVisible)
            If Not rngFound Is Nothing Then
                For Each cel In rngFound
                    If Not IsNumeric(cel.Value) Then
                        ' Try to add the cell value to the collection
                        ' This will fail if the same value has already been added
                        col.Add Item:=cel.Value, Key:=CStr(cel.Value)
                    End If
                Next cel
            End If
            .AutoFilterMode = False
        End With
        ' Fill the list box from the collection
        For Each itm In col
            Me.ListBox1.AddItem itm
        Next itm
    End Sub


    Regards, Hans Vogelaar (http://www.eileenslounge.com)

    Sunday, January 18, 2015 11:07 PM
  • Dude You are a Rock-Star.... Yes it does! I was able to figure out the "Sort" form there. Thanks again

    For Each itm In col
    With ListBox1
            .AddItem itm

            For i = 0 To .ListCount - 2
                For j = i + 1 To .ListCount - 1
                    If .List(i) > .List(j) Then
                        itm = .List(j)
                        .List(j) = .List(i)
                        .List(i) = itm
                    End If
                Next j
            Next i
        End With
    Next itm


    Monday, January 19, 2015 12:53 AM