limiting Listbox results

[roninn75]

good day
I am utilising a userform to find related records and displaying the results in specific fields on the form. I can scroll through these records using spin buttons. I also have a listbox that I want to limit to only show the results from the initial find query instead of everything that is on the sheet. My request is:
1. How can i limit the results in the listbox to only show the results from the find query?
2. I want to update or edit the related record based on what was found.

Here is my code for the find button:

Code: Select all

Public Sub BtnFind_Click()

'**********************************
Dim ws As Worksheet
Set ws = Sheets("DATA")

    With ws
        ws.Activate
        'find Record
        If Me.BxFDate.Value = "" Then
            MsgBox "please enter a date to search for"
            Exit Sub
        End If
        strFind = Me.BxFDate.Value
        Set c = rsearch.Find(What:=strFind, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)
        If Not c Is Nothing Then    'found it
            Init_FindResults
            Show_FindResults
            
        With LstResults  'populate the listbox
            .RowSource = "DATA!A2:U390"       ' this should be limited to only show the results from the find query, not the entire sheet
            .ColumnHeads = True
'           .List = [TblList].Value
            .ColumnCount = 11
            .ColumnWidths = "60;60;60;80;120;140;50;80;60;60;60"
        End With
        Else
            MsgBox "No exact match was found. Please try again"
            
        End If
    End With
'***********************************
End Sub

Any ideas would be helpful, thanks

[HansV]

What is the code for Init_FindResults and Show_FindResults?

[roninn75]

hi
The Show_FindResults code is:

Code: Select all

Private Sub Show_FindResults()
    c.Select
    LblActiveRow = ActiveCell.Row
        Me.BxFDate.Value = c
        Me.BxDate.Value = c
        Me.TxtDay.Value = c.Offset(0, 1).Value
        Me.BxDept.Value = c.Offset(0, 2).Value
        Me.BxStatus.Value = c.Offset(0, 3).Value
        Me.TxtCancel.Value = c.Offset(0, 4).Value
        Me.TxtDescription.Value = c.Offset(0, 5).Value
        Me.TxtMSR.Value = c.Offset(0, 6).Value
        Me.TxtRequestor.Value = c.Offset(0, 7).Value
        Me.BxArea.Value = c.Offset(0, 8).Value
        Me.TxtLocation.Value = c.Offset(0, 9).Value
        Me.BxFlightTime.Value = c.Offset(0, 10).Value

'        Me.LblFUser.Caption = c.Offset(0, 21).Value
'        Me.LblFDateTime.Caption = c.Offset(0, 22).Value
End Sub

The Init_FindResults is merely:

Code: Select all

Public Sub Init_FindResults()
    BxFDate.Value = vbNullString
End Sub

[HansV]

Try this. It's "air code", obviously.

Code: Select all

Public Sub BtnFind_Click()
    '**********************************
    Dim ws As Worksheet
    Dim strFind As String
    Dim adr As String
    Dim r As Long
    Dim i As Long
    Dim n As Long

    Set ws = Sheets("DATA")

    With ws
        ws.Activate
        'find Record
        If Me.BxFDate.Value = "" Then
            MsgBox "please enter a date to search for"
            Exit Sub
        End If
        strFind = Me.BxFDate.Value
        Set c = rSearch.Find(What:=strFind, LookIn:=xlValues, _
            LookAt:=xlWhole, MatchCase:=False)
        If Not c Is Nothing Then    'found it
            Init_FindResults
            Show_FindResults
            
            adr = c.Address
            With LstResults  'populate the listbox
                .Clear
                .ColumnHeads = False
                .ColumnCount = 11
                .ColumnWidths = "60;60;60;80;120;140;50;80;60;60;60"
                Do
                    .AddItem ws.Cells(r, 1).Value
                    For i = 1 To 10
                        .List(n, i) = ws.Cells(r, i + 1).Value
                    Next i
                    Set c = rSearch.Find(What:=strFind, After:=c, _
                        LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)
                    If c Is Nothing Then Exit Do
                    n = n + 1
                Loop Until c.Address = adr
            End With
        Else
            MsgBox "No exact match was found. Please try again"
        End If
    End With
'***********************************
End Sub

[roninn75]

thanks, kicks out an error:

Code: Select all

.AddItem ws.Cells(r, 1).Value

[HansV]

Could you attach a copy of the workbook without sensitive data?

[snb]

see the attachment

[roninn75]

please see attached

[HansV]

That was more complicated than I expected. We cannot use AddItem if the list box has more than 10 columns. We have to set the list in one go. But there is a bug if the list has only one row, so I had to work around that.
See the attached version.

log_sample.xlsm

[roninn75]

thank you, this works

[roninn75]

Hi Hans
Can I increase the column count?

[HansV]

Yes. Change the column count and the column widths in design view.
And add the new column(s) to all pieces of code that refer to the list box.
In the attached version, the Footage Requested column has been added. I entered some dummy data in the worksheet.

log_sample.xlsm

[roninn75]

thank you