Home > Net >  how to add column more than 10 at listbox?
how to add column more than 10 at listbox?

Time:12-09

in my userform, there are combobox, textbox and listbox. here are the codes

Private Sub UserForm_Initialize()
Me.BackColor = RGB(22, 54, 92)
Me.Label1.ForeColor = RGB(255, 255, 255)
Me.Label2.ForeColor = RGB(255, 255, 255)

Dim c As Integer
For c = 1 To 2
Me.ComboBox1.AddItem Sheet7.Cells(1, c).Value
Next

End Sub

here is the code for combobox

Private Sub ComboBox1_Change()
    
    Dim c As Integer
    Dim column_headers
    column_headers = Array("A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N", "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z", "AA", "AB", "AC", "AD", "AE", "AF", "AG", "AH", "AI", "AJ", "AK", "AL", "AM")
    
    For c = 1 To 39
    If Sheet7.Cells(1, c).Value = Me.ComboBox1.Value Then
    criterion = column_headers(c - 1)
    End If
    Next
    
    Me.ListBox1.Clear
    Me.TextBox1.Value = ""
    Me.TextBox1.SetFocus
    
End Sub

here is the code for textbox1

Private Sub TextBox1_Change()
On Error Resume Next
If Me.TextBox1.Text = "" Then
Exit Sub
End If

Me.ListBox1.Clear
Dim r, last_row As Integer
last_row = Sheet7.Cells(Rows.Count, 2).End(xlUp).Row

With Me.ListBox1
    .ColumnCount = 39
End With

For r = 2 To last_row
    A = Len(Me.TextBox1.Text)
    If UCase(Left(Sheet7.Cells(r, criterion).Value, A)) = UCase(Me.TextBox1.Text) Then
    
    With Me.ListBox1
    .AddItem Sheet7.Cells(r, 1).Value
    .List(.ListCount - 1, 1) = Sheet7.Cells(r, 2).Value
    .List(.ListCount - 1, 2) = Sheet7.Cells(r, 3).Value
    .List(.ListCount - 1, 3) = Sheet7.Cells(r, 4).Value
    .List(.ListCount - 1, 4) = Sheet7.Cells(r, 5).Value
    .List(.ListCount - 1, 5) = Sheet7.Cells(r, 6).Value
    .List(.ListCount - 1, 6) = Sheet7.Cells(r, 7).Value
    .List(.ListCount - 1, 7) = Sheet7.Cells(r, 8).Value
    .List(.ListCount - 1, 8) = Sheet7.Cells(r, 9).Value
    .List(.ListCount - 1, 9) = Sheet7.Cells(r, 10).Value
    .List(.ListCount - 1, 10) = Sheet7.Cells(r, 11).Value
    .List(.ListCount - 1, 11) = Sheet7.Cells(r, 12).Value
    .List(.ListCount - 1, 12) = Sheet7.Cells(r, 13).Value
    .List(.ListCount - 1, 13) = Sheet7.Cells(r, 14).Value
    .List(.ListCount - 1, 14) = Sheet7.Cells(r, 15).Value
    .List(.ListCount - 1, 15) = Sheet7.Cells(r, 16).Value
    .List(.ListCount - 1, 16) = Sheet7.Cells(r, 17).Value
    .List(.ListCount - 1, 17) = Sheet7.Cells(r, 18).Value
    .List(.ListCount - 1, 18) = Sheet7.Cells(r, 19).Value
    .List(.ListCount - 1, 19) = Sheet7.Cells(r, 20).Value
    .List(.ListCount - 1, 20) = Sheet7.Cells(r, 21).Value
    .List(.ListCount - 1, 21) = Sheet7.Cells(r, 22).Value
    .List(.ListCount - 1, 22) = Sheet7.Cells(r, 23).Value
    .List(.ListCount - 1, 23) = Sheet7.Cells(r, 24).Value
    .List(.ListCount - 1, 24) = Sheet7.Cells(r, 25).Value
    .List(.ListCount - 1, 25) = Sheet7.Cells(r, 26).Value
    .List(.ListCount - 1, 26) = Sheet7.Cells(r, 27).Value
    .List(.ListCount - 1, 27) = Sheet7.Cells(r, 28).Value
    .List(.ListCount - 1, 28) = Sheet7.Cells(r, 29).Value
    .List(.ListCount - 1, 29) = Sheet7.Cells(r, 30).Value
    .List(.ListCount - 1, 30) = Sheet7.Cells(r, 31).Value
    .List(.ListCount - 1, 31) = Sheet7.Cells(r, 32).Value
    .List(.ListCount - 1, 32) = Sheet7.Cells(r, 33).Value
    .List(.ListCount - 1, 33) = Sheet7.Cells(r, 34).Value
    .List(.ListCount - 1, 34) = Sheet7.Cells(r, 35).Value
    .List(.ListCount - 1, 35) = Sheet7.Cells(r, 36).Value
    .List(.ListCount - 1, 36) = Sheet7.Cells(r, 37).Value
    .List(.ListCount - 1, 37) = Sheet7.Cells(r, 38).Value
    .List(.ListCount - 1, 38) = Sheet7.Cells(r, 39).Value
   
End If
Next r
End Sub

why the listbox on userform3 only shows 10 column? what's wrong? thank you

CodePudding user response:

instead of the additem:

With Me.ListBox1
    .List = Sheet7.Cells(2, 2).Resize(last_row - 1, 38).Value
    .ColumnCount = UBound(.List, 2)   1
End With

CodePudding user response:

Please, using the next adapted code. You need to have a Private variable on top of the form code module (in the declarations area):

  Private criterion As String

Then, copy the next code event instead of yours:

Private Sub TextBox1_Change()
 If Me.TextBox1.Text = "" Then Exit Sub

 Me.ListBox1.Clear
 Dim r As Long, last_row As Long, a As Long
 last_row = Sheet7.cells(rows.count, 2).End(xlUp).row 'last row of Sheet7

 Me.ListBox1.ColumnCount = 39

 Dim arrFin, critCount As Long, k As Long, j As Long
 ReDim arrFin(1 To 39, 1 To last_row)  'redim the array to keep the necessary data

 For r = 2 To last_row                      'iterate between the sheet range
    a = Len(Me.TextBox1.Text)        'place the TextBox1 text in the variable
    If UCase(left(Sheet7.cells(r, criterion).Value, a)) = UCase(Me.TextBox1.Text) Then 'check if the string starts with chars from txtB1
        k = k   1                                    'increment the rows variable
        For j = 1 To UBound(arrFin)
            arrFin(j, k) = Sheet7.cells(r, j) 'load the array to place in the list box
        Next j
   End If
 Next r
 
  If k > 0 Then 'if a match has been found
     ReDim Preserve arrFin(1 To 39, 1 To k) 'eliminate the emply elements of the array
     If k = 1 Then
         transpose2D arrFin            'transposing a 2D array with a row, a 1D array will result...
         Me.ListBox1.List = arrFin  'drop the built array content in the list box
     Else
         Me.ListBox1.List = Application.Transpose(arrFin) 'drop the transposed array content
    End If
  End If
End Sub

Sub transpose2D(ByRef arr) 'transform the 2D one column in 2D one row:
   Dim i As Long, arr2D, k As Long
   ReDim arr2D(1 To 1, 1 To UBound(arr)   1)
   For i = LBound(arr) To UBound(arr)
        k = k   1
        arr2D(1, k) = arr(i, 1)
   Next
   arr = arr2D
End Sub

When place a question you need to understand the code you show. Looking to the other procedures i deduced that the recommended global/private variable must exist...

I commented al the code lines which you may not understand. If something still not clear enough, do not hesitate to ask for clarifications.

  • Related