Load Userform With Multiple Column Data

[adam]

Hi anyone,

The following code initializes user form from data only from column G.

Code: Select all

Private Sub UserForm_Initialize()
Dim aRow As Long
Dim LastRow As Long

LastRow = ActiveWorkbook.Worksheets("MySheet").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

For aRow = 2 To LastRow
    Me.lboxClientes.AddItem Sheet1.Range("G" & aRow)
Next

End Sub

How can I make the code to load data into user form's listbox from columns D to column Z. My data rows start from row 17 in "MySheet".

Any help on this would be kindly appreciated.

Thanks in advance.

[Becks]

If you want the list box to display multiple columns, try this

Code: Select all

Private Sub UserForm_Initialize()
Dim LastRow As Long
Dim wksMySheet As Worksheet
Dim aMyArray As Variant

Set wksMySheet = ActiveWorkbook.Worksheets("MySheet")
LastRow = wksMySheet.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

aMyArray = wksMySheet.Range("D17:Z" & LastRow)
 
With Me.lboxClientes
    .ColumnCount = 26 - 4
    .List() = aMyArray
End With

End Sub

Kevin

[adam]

Thanks for the help. I have a text box which filters the list box with the value in the text box. But this text box searches values only from column G but not the other columns.

Code: Select all

Private Sub txtSearchItem_Exit(ByVal Cancel As MSForms.ReturnBoolean)
     
    Dim aRow As Long
    Dim LastRow As Long
    Dim WS As Worksheet
    Set WS = ActiveWorkbook.Worksheets("MySheet")
     
    If Me.txtSearchItem <> "" Then
        Me.lboxClientes.Clear
        With Me.lboxClientes
             
            LastRow = WS.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
            For aRow = 2 To LastRow
                If InStr(UCase(WS.Range("G" & aRow).Value), UCase(Me.txtSearchItem)) <> 0 Then
                    .AddItem WS.Range("G" & aRow).Value
                End If
            Next
        End With
    End If
     
End Sub

Suppose If I have apple in column B, the code does not filter the list box if I write apple. But it filters the values that I write from column G. How could I make the code to search text from the appropriate column and filter the list box.

Any help on this would be kindly appreciated. Thanks in advance.

[adam]

I've tried with the following method. But my code is failing.

What may I be doing wrong in here?

Code: Select all

Private Sub txtSearchItem_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Dim aRow As Long
Dim iCol As Integer
Dim LastRow As Long
Dim wksMySheet As Worksheet
Dim aMyArray()

Set wksMySheet = ActiveWorkbook.Worksheets("MySheet")

If Me.txtSearchItem <> "" Then
        Me.lboxClientes.Clear
        With Me.lboxClientes
        
LastRow = wksMySheet.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

ReDim aMyArray(17 To LastRow, 4 To 26)
For aRow = 17 To LastRow
                If InStr(UCase(WS.Range(aMyArray & aRow).Value), UCase(Me.txtSearchItem)) <> 0 Then
                    .AddItem WS.Range(aMyArray & aRow).Value
    For iCol = 4 To 26
        aMyArray(aRow, iCol) = wksMySheet.Cells(aRow, iCol).Value
    Next iCol
Next aRow

With Me.lboxClientes
    .ColumnCount = 26 - 4
    .List() = aMyArray
End With
End Sub

Any help On this would be kindly appreciated.

[Becks]

This code will find the occurrence in any cell and show the entire row

Code: Select all

Private Sub txtSearchItem_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Dim aRow As Long
Dim iCol As Integer
Dim LastRow As Long
Dim wksMySheet As Worksheet
Dim aMyArray()
Dim rngArray As Range
Dim rngFound As Range

    If Len(Me.txtSearchItem.Value) = 0 Then Exit Sub
    
    Set wksMySheet = ActiveWorkbook.Worksheets("MySheet")
    LastRow = wksMySheet.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    
    For aRow = 17 To LastRow
        Set rngFound = wksMySheet.Range("D" & aRow).Resize(1, 22).Find(What:=Me.txtSearchItem.Value, LookAt:=xlPart, MatchCase:=False)
        If Not (rngFound Is Nothing) Then
            Set rngFound = wksMySheet.Range("D" & aRow).Resize(1, 22)
            If rngArray Is Nothing Then
                Set rngArray = rngFound
            Else
                Set rngArray = Application.Union(rngArray, rngFound)
            End If
        End If
    Next aRow
        
    aMyArray = rngArray
    
    With Me.lboxClientes
        .Clear
        .List() = aMyArray
    End With
End Sub

Kevin

[adam]

Thanks for the help. But why doesn't' the code show all the list box rows when the value in the txtSearchItem is cleared?

[Becks]

This will restore the list box

Code: Select all

Private Sub txtSearchItem_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Dim aRow As Long
Dim iCol As Integer
Dim LastRow As Long
Dim wksMySheet As Worksheet
Dim aMyArray()
Dim rngArray As Range
Dim rngFound As Range

    Set wksMySheet = ActiveWorkbook.Worksheets("MySheet")
    LastRow = wksMySheet.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    
    If Len(Me.txtSearchItem.Value) = 0 Then
        aMyArray = wksMySheet.Range("D17:Z" & LastRow)
        
        With Me.lboxClientes
            .Clear
            .List() = aMyArray
        End With
    Else
        
        For aRow = 17 To LastRow
            Set rngFound = wksMySheet.Range("D" & aRow).Resize(1, 22).Find(What:=Me.txtSearchItem.Value, LookAt:=xlPart, MatchCase:=False)
            If Not (rngFound Is Nothing) Then
                Set rngFound = wksMySheet.Range("D" & aRow).Resize(1, 22)
                If rngArray Is Nothing Then
                    Set rngArray = rngFound
                Else
                    Set rngArray = Application.Union(rngArray, rngFound)
                End If
            End If
        Next aRow
            
        aMyArray = rngArray
        
        With Me.lboxClientes
            .Clear
            .List() = aMyArray
        End With
    End If
End Sub

Kevin

[adam]

Thanks for the help. It worked fine. Is there way I could make the column Headers visible?

[Becks]

Only if the data can be copied to another part of the workbook...

Kevin