CODEWITHSUNDEEP
vbaexcelfilterlistboxitem
J.O.P.P.
J.O.P.P.

Reputation: 177

My (Vba) Code only works with 1 variable in the list, and gives only blanks back when multiple variables used in listbox

I've got a code that puts all the data of my Excel file (rows = 12,5k+ and columns = 97) in to a two-dimensional string. Then it loops through a certain column ("G") to list an listbox ("listbox1") with only unique findings. Then in the Userform the user can choose to select some of the found items and transform it to another listbox ("Listbox2") Then when the user hits the button (CommandButton4) I would like the code to filter the array on only the rows where in column "G" it is the same as in one (or more) given criteria in listbox2. It works when It has only one item in the listbox but when given two items in the listbox, it only returns everything blank.

Can some one please tell me what I'm doing wrong because I've no idea.

code:

Private Sub CommandButton4_Click()
    Dim arr2() As Variant
    Dim data As Variant
    Dim B_List As Boolean
    Dim i As Long, j As Long, q As Long, r As Long, LastColumn  As Long, LastRow As Long
    q = 1
    r = 1

    Dim ws As Worksheet
    Set ws = ActiveWorkbook.Sheets("Sheet3")
    Application.ScreenUpdating = False
    Application.EnableEvents = False

    With ThisWorkbook.Sheets("Sheet3")
        LastRow = .Cells(Rows.Count, 2).End(xlUp).Row
        LastColumn = .Cells(3, Columns.Count).End(xlToLeft).Column
        ReDim arr2(1 To LastRow, 1 To LastColumn)

        For i = 2 To LastRow
            For j = 1 To LastColumn
                arr2(i, j) = .Cells(i, j).Value
            Next j
        Next i
    End With

    For i = 1 To LastRow
        For j = 0 To Me.ListBox2.ListCount - 1
            If ListBox2.List(j) = arr2(i, 7) Then
                'Later aan te passen
            Else
                For q = 1 To LastColumn
                    arr2(i, q) = ""
                Next q
            End If
        Next j
    Next i

    Sheets("Sheet3").UsedRange.ClearContents

    For i = LBound(arr2, 1) To UBound(arr2, 1)
        If arr2(i, 2) <> "" Then
            r = r + 1
            For j = LBound(arr2, 2) To UBound(arr2, 2)
                ThisWorkbook.Sheets("Sheet3").Cells(r, j).Value = arr2(i, j)

            Next j
        End If
        Debug.Print i, j, arr2(i, 7)
    Next i

    Application.ScreenUpdating = True
    Application.EnableEvents = True

End Sub

Upvotes: 0

Views: 147

Answers (1)

Chronocidal
Chronocidal

Reputation: 7951

The issue is your second nested-loop:

For i = 1 To LastRow
    For j = 0 To Me.ListBox2.ListCount - 1
        If ListBox2.List(j) = arr2(i, 7) Then
            'Later aan te passen
        Else
            For q = 1 To LastColumn
                arr2(i, q) = ""
            Next q
        End If
    Next j
Next i

Suppose that our ListBox has 2 values, "First" and "Second". For each row, you do the following:

j = 0

ListBox2.List(0) = "First"

If Column G is "First", do nothing

Otherwise, make the whole Row Blank Including if Column G = "Second"

At this point, the only possible values for Column G are now "First" or Blank

j = 1

ListBox2.List(1) = "Second"

If Column G is "Second", do nothing But, this cannot happen, because you have already changed any "Second" Rows to Blank

Otherwise, make the whole Row Blank

At this point, the Row will always be Blank

I recommend having a Boolean test variable. Set it to False at the start of each Row-loop, and set it to True if you find a match. If it is still False after you check all ListBox items, then blank the row:

Dim bTest AS Boolean
For i = 1 To LastRow
    bTest = False 'Reset for the Row
    For j = 0 To Me.ListBox2.ListCount - 1
        If ListBox2.List(j) = arr2(i, 7) Then
            bTest = True 'We found a match!
            Exit For 'No need to keep looking
        End If
    Next j
    If Not bTest Then 'If we didn't find a match
        For q = 1 To LastColumn
            arr2(i, q) = "" 'Blank the row
        Next q
    End If
Next i

Upvotes: 1

Related Questions