Listbox showing unwanted blanks after AddItem in Do While Loop

[Jonerke]

Dear reader,

I'm populating a Userform Listbox through a module that looks like this:

Dim FindString As String
Dim LastRowStk As Integer
Dim Rng As Range
Dim Foundtwo As String
Dim FLRow As Integer


FindString = "Something"
LastRowStk = Worksheets(1).Range("A" & Rows.Count).End(xlUp).Row


Set Rng = Worksheets(1).Range("P1:P" & LastRowStk).Find(What:=FindString)
Foundtwo = Rng.Address
FLRow = Rng.Row
i = 0


Do
    UserForm2.ListBox1.AddItem
    UserForm2.ListBox1.List(i, 0) = Range("A" & FLRow).Value
    UserForm2.ListBox1.List(i, 1) = Range("C" & FLRow).Value
    Set Rng = Worksheets(1).Range("P1:P" & LastRowStk).FindNext(Rng)
    FLRow = Rng.Row
    i = i + 1
    
Loop While Rng.Address <> Foundtwo

The code works fine but I have two problems with it:

1) The listbox shows just as many blanks as there are hits. I think this happens because the loop repeats the AddItem everytime. A solution would be to use a for-loop but that would slow the search down considerably. I need to go through 7000 rows, find the row number and return a value in column "A" and "C" that will be shown in the listbox. The FindNext is much faster but I need to combine it with a Do Loop.
2) I want the results to be shown in the opposite order (reversed). On top of the Listbox I want the last hit and then the second last hit and so on.

Maybe I should put everything in an Array first and then populate the Listbox from there but I have no idea how to do this.

Any thoughts ? All help is very welcome

Many thanks,
Jonerke

 

[dmt32]

Hi,

Not tested but try this update to your code & see if helps first part:

Dim FindString As String, FirstAddress As String
    Dim i As Integer
    Dim FoundCell As Range
    
    FindString = "Something"
    
    With Worksheets(1)
    Set FoundCell = .Columns(16).Find(What:=FindString, LookIn:=xlValues, lookat:=xlWhole)
        If Not FoundCell Is Nothing Then
            FirstAddress = FoundCell.Address
    
            Do
                UserForm2.ListBox1.AddItem
                UserForm2.ListBox1.List(i, 0) = .Cells(FoundCell.Row, 1).Value
                UserForm2.ListBox1.List(i, 1) = .Cells(FoundCell.Row, 3).Value
                Set FoundCell = .Columns(16).FindNext(FoundCell)
                i = i + 1
            Loop While Not FoundCell Is Nothing And FoundCell.Address <> FirstAddress
        Else
            MsgBox FindString & Chr(10) & "Record Not Found", 48, "Not Found"
        End If
    
    End With

The solution has largely been taken from VBA helpfile for FindNext Method.

Hope Helpful

Dave

 

[Jonerke]

Hi Dave,

Thanks for completing the Find syntax.
There was actually nothing wrong with the Find - FindNext as the results were correctly shown in the listbox. The problem is just that I get unnecessary rows of blanks that I don't want to see. It makes the listbox unnecessary big (including having to scroll) and it doesn't look nice. Also Ik would like to see my results in a reversed order.

Jonerke

 

[dmt32]

do I take it solution resolved the blank row issue?

Dave

 

[Norie]

Jonerke

Putting everything in an array is probably the way to go and should be quite straightforward.

First you would populate an array with all the data, like this.

arrData = Worksheets(1).Range("A1:P" & LastRowStk)

You would then loop through that array and populate another array based on the criteria, something like this.

Dim arrFilter() As Variant
Dim cnt As Long

    For I = LBound(arrData) To UBound(arrData)
        If arrData(I, 16) = FindString
            ReDim Preserve arrFilter(1 to 2, cnt)
            arrFilter(1, cnt) = arrData(I, 1)
            arrFilter(2, cnt) = arrData(I, 3)
            cnt = cnt+1
        End If
    Next I

    UserForm2.ListBox1.Column = arrFilter

So all together.

Private Sub UserForm_Initialize()
Dim arrData As Variant
Dim arrFilter() As Variant
Dim cnt As Long
Dim LastRowStk As Long
Dim FindString As Long

    FindString = "Test"
    
    LastRowStk = Worksheets(1).Range("A" & Rows.Count).End(xlUp).Row
    
    arrData = Worksheets(1).Range("A1:P" & LastRowStk)
    
    For I = LBound(arrData) To UBound(arrData)
        If arrData(I, 16) = findstring Then
            ReDim Preserve arrFilter(1 To 2, cnt)
            arrFilter(1, cnt) = arrData(I, 1)
            arrFilter(2, cnt) = arrData(I, 3)
            cnt = cnt + 1
        End If
    Next I

    ListBox1.Column = arrFilter
    ListBox1.ColumnCount = 2
    
End Sub

 

[Jonerke]

Hi Norie,

Thanks! Now it's working without showing blanks Just one challange left: how to get the array shown in reversed order. So, if I get the following result in my Array:

Apples 5
Brownies 9
Fishsticks 2
Bananas 1

I want it to be shown as such in my listbox:

Bananas 1
Fischsticks 2
Brownies 9
Apples 5

Any idea on how to reverse this ?

Many thanks already!

Jonas

 

[Norie]

Not 100% sure what you want but I think reversing the loop might be what you are looking for.

For I = UBound(arrData) To LBound(arrData) Step -1

 

[Jonerke]

Hi Norie,

That's it exactly! Case closed

Many thanks,
Jonas