CODEWITHSUNDEEP
excelvba
Shurastey
Shurastey

Reputation: 39

Populate Listbox Multiple Column With Criteria

I have a 'textbox' (lstDetalhe) in my 'userform' (frmFormDetalhe) and I would like to display only data whose id is the same as ChaveEstrangeira...

Sub Detalhe()

    Dim UltimaLinha As Integer
    Dim Rng As Range
    Dim ChaveEstrangeira As Integer

    ChaveEstrangeira = frmForm.lstCarteira.Value
    Set Resumo = Sheets("Resumo")

    UltimaLinha = [Counta(Resumo!A:A)]



   For i = 1 To UltimaLinha

        If Sheets("Resumo").Range("B" & i).Value = ChaveEstrangeira Then
            frmFormDetalhe.lstDetalhe.ColumnCount = 5
            frmFormDetalhe.lstDetalhe.AddItem Sheets("Resumo").Range("C" & i).Value

        End If

    Next i

End Sub

it turns out that only one column returns to me. How to return multiple columns?

----EDIT---

I did it this way:

Sub Detalhe()

    Dim UltimaLinha As Integer
    Dim ChaveEstrangeira As Integer
    Dim Resumo As Object
    Dim i

    ChaveEstrangeira = frmForm.lstCarteira.Value
    UltimaLinha = [Counta(Resumo!A:A)]
    Set Resumo = Sheets("Resumo")

    With frmFormDetalhe
       .lstDetalhe.ColumnCount = 11
       .lstDetalhe.ColumnHeads = False
       .lstDetalhe.ColumnWidths = "20;55;50;50;50;60;55;75;50;50"

       For i = 2 To UltimaLinha

            If Sheets("Resumo").Range("B" & i).Value = ChaveEstrangeira Then
                .lstDetalhe.AddItem 'Resumo.Range("A1:K1").Cells(i, 1)
                .lstDetalhe.List(.lstDetalhe.ListCount - 1, 0) = Resumo.Range("A1:K1").Cells(i, 1)
                .lstDetalhe.List(.lstDetalhe.ListCount - 1, 1) = Resumo.Range("A1:K1").Cells(i, 2)
                .lstDetalhe.List(.lstDetalhe.ListCount - 1, 2) = Resumo.Range("A1:K1").Cells(i, 3)
                .lstDetalhe.List(.lstDetalhe.ListCount - 1, 3) = Resumo.Range("A1:K1").Cells(i, 4)
                .lstDetalhe.List(.lstDetalhe.ListCount - 1, 4) = Resumo.Range("A1:K1").Cells(i, 5)
                .lstDetalhe.List(.lstDetalhe.ListCount - 1, 5) = Resumo.Range("A1:K1").Cells(i, 6)
                .lstDetalhe.List(.lstDetalhe.ListCount - 1, 6) = Resumo.Range("A1:K1").Cells(i, 7)
                .lstDetalhe.List(.lstDetalhe.ListCount - 1, 7) = Resumo.Range("A1:K1").Cells(i, 8)
                .lstDetalhe.List(.lstDetalhe.ListCount - 1, 8) = Resumo.Range("A1:K1").Cells(i, 9)
                .lstDetalhe.List(.lstDetalhe.ListCount - 1, 9) = Resumo.Range("A1:K1").Cells(i, 10)
                .lstDetalhe.List(.lstDetalhe.ListCount - 1, 10) = Resumo.Range("A1:K1").Cells(i, 11) 'ERROR HERE
             End If

        Next i
    End With

End Sub

But it seems that this last line is reporting an error ...when I change 10 to a number of 1 just any number it returns without error...

Upvotes: 0

Views: 747

Answers (1)

FaneDuru
FaneDuru

Reputation: 42236

Try this code, please. It is good to create a habit of using Long variables instead of Integer. VBA loads memory with Longs, anyhow and no benefit of using Integer. Since no benefit from memory load point of view, a Long variable offer more space. Then, declare Resumo variable As Worksheet:

Sub Detalhe()
    Dim UltimaLinha As Long, ChaveEstrangeira As Long, Resumo As Worksheet
    Dim arrList As Variant, i As Long, j As Long, k As Long

    Set Resumo = Sheets("Resumo")
    ChaveEstrangeira = CLng(frmForm.lstCarteira.value)
    UltimaLinha = Resumo.Range("A" & Rows.count).End(xlUp).Row
    ReDim arrList(1 To 11, 1 To UltimaLinha)'initial array dim, but with last dimension  being rows. Only the last dimension can be ReDim Preserve

       For i = 2 To UltimaLinha
            If Resumo.Range("B" & i).value = ChaveEstrangeira Then
                k = k + 1 'array row to be filled
                For j = 1 To 11 'load the array columns for K row
                     arrList(j, k) = Resumo.Range("A1:K1").Cells(i, j)
                Next j
             End If
        Next i

        ReDim Preserve arrList(1 To 11, 1 To k) 'redim the array to the maximum found occurrences
        With frmFormDetalhe
           .lstDetalhe.ColumnCount = 11
           .lstDetalhe.ColumnHeads = False
           .lstDetalhe.ColumnWidths = "20;55;50;50;50;60;55;75;50;50;50"'added the eleventh column width 
           .lstDetalhe.list = WorksheetFunction.Transpose(arrList)
        End With
End Sub

Upvotes: 1

Related Questions