Error with code searching database sheet returning to list box

[StartingOut]

Hi, I have this code to search my "Membership Sales" worksheet. but it will not run and highlights .List(.ListCount - 1, 11) = c.Offset(0, (x + 10)).Value and returns the error "could not set the list property" it seams that if I comment that line out it simply fails on the next line as if the rows starting in the double digits are not right.

I'm just not seeing the problem.

"With Me.ListBox1
.AddItem c.Value
.List(.ListCount - 1, 0) = c.Offset(0, x).Address 'record number
.List(.ListCount - 1, 1) = c.Offset(0, x).Value 'surname
.List(.ListCount - 1, 2) = c.Offset(0, (x + 1)).Value 'first name
.List(.ListCount - 1, 3) = c.Offset(0, (x + 2)).Value 'DOB
.List(.ListCount - 1, 4) = c.Offset(0, (x + 3)).Value 'address
.List(.ListCount - 1, 5) = c.Offset(0, (x + 4)).Value 'date spoken to
.List(.ListCount - 1, 6) = c.Offset(0, (x + 5)).Value 'notes
.List(.ListCount - 1, 7) = c.Offset(0, (x + 6)).Value
.List(.ListCount - 1, 8) = c.Offset(0, (x + 7)).Value
.List(.ListCount - 1, 9) = c.Offset(0, (x + 8)).Value
.List(.ListCount - 1, 10) = c.Offset(0, (x + 9)).Value
.List(.ListCount - 1, 11) = c.Offset(0, (x + 10)).Value
.List(.ListCount - 1, 12) = c.Offset(0, (x + 11)).Value
.List(.ListCount - 1, 13) = c.Offset(0, (x + 12)).Value
.List(.ListCount - 1, 14) = c.Offset(0, (x + 13)).Value
.List(.ListCount - 1, 15) = c.Offset(0, (x + 14)).Value
.List(.ListCount - 1, 16) = c.Offset(0, (x + 15)).Value
.List(.ListCount - 1, 17) = c.Offset(0, (x + 16)).Value
.List(.ListCount - 1, 18) = c.Offset(0, (x + 17)).Value
.List(.ListCount - 1, 19) = c.Offset(0, (x + 18)).Value
.List(.ListCount - 1, 20) = c.Offset(0, (x + 19)).Value
.List(.ListCount - 1, 21) = c.Offset(0, (x + 20)).Value


End With"

 

[StartingOut]

Yes it is in a UserForn I would be fine putting this on a worksheet as embedded, but then I don't know how to write that code

 

[Jerry Sullivan]

No problem. My mistake assuming
(for future reference, it's good to note whether your listbox/combox box is on a Userform or Worksheet, ActiveX or Forms in the Original Post since the code for handling each of these can be different).

This article by Ken Puls gives two clear examples.
Excelguru Help Site - Fill MultiColumn Listbox With Worksheet Range

Just ask if you need any help adapting one of those for your workbook.

 

[StartingOut]

Thanks Jerry, I am going to try it, i'll keep you posted

 

[StartingOut]

Hi Jerry, the link you gave me has good code and I am trying to incorporate it into my workbook but getting a Syntax error on this part for Data = Trim part the error occurs all the code lined after"Trin(Data) and before the "If Not FoundIt Is Nothing" get highlighted in yellow. I welcome some direction

With SrcWks
        Set rngSource = Worksheets("Membership Sales").Range("A2:V2")
        Set RngEnd = .Cells(Rows.Count, Col).End(xlUp)
        'Set RngEnd = IIf(RngEnd.Row < Rng.Row, Rng, RngEnd)
        'Set Rng = .Range(Rng, RngEnd)
    End With


    Data = Trim(Data)
    Set FoundIt = Worksheets("Membership Sales").Range("A2:V2"), _
                           LookIn:=xlFormulas, LookAt:=CheckBox2.Value + 2, _
                           SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                           MatchCase:=CheckBox1.Value)
    If Not FoundIt Is Nothing Then
        FirstAddx = FoundIt.Address
        If CheckBox3.Value = False Then Exit Sub
        Set FoundIt = Rng.FindNext(FoundIt)
        R = R + 1

 

[Jerry Sullivan]

It's hard to know for sure without seeing the latest version of your code; however comparing the code in Post #3, I don't see that you are assigning anything to the variable Data.

You have this line....

 Set MyData = SrcWks.Range("A2:V20").CurrentRegion

Please post the entire latest version if you aren't finding the problem.

 

[StartingOut]

Jerry I wasn't sure if you all the code or just the code for this search and populate of the ListBox. I guessed it just that portion

Private Sub CommandButton1_Click()
'SEARCH
    Dim c As Variant
    Dim Col As Variant
    Dim Data As Variant
    Dim FirstAddx As String
    Dim FoundIt As Range
    Dim I As Integer
    Dim R As Long
    Dim Rng As Range
    Dim RngEnd As Range
    Dim SrcWks As Worksheet
    Dim strFind As String    'what to find
    Dim x As Long




With Worksheets("Membership Sales")
.Unprotect Password:="taylor97"
End With




    Set SrcWks = Worksheets("Membership Sales")
    Set MyData = SrcWks.Range("A2:V20").CurrentRegion












    With Frame1.Controls
        For I = 0 To .Count - 1
            If .Item(I).Value = True Then
                BtnName = .Item(I).Name
                Exit For
            End If
        Next I
    End With




    Select Case BtnName
    Case "OptionButton1"
        strFind = TextBox1
        x = 0 - 4
        Col = 5: Data = TextBox1: GoSub DataSearch
    Case "OptionButton2"
        strFind = TextBox1
        x = 0 - 5
        Col = 6: Data = TextBox1: GoSub DataSearch
    Case "OptionButton3"
        strFind = TextBox1
        'x = 0 - 5
        Col = 1: Data = TextBox1: GoSub DataSearch
    Case "OptionButton4"
        strFind = TextBox1
        x = 0 - 19
        Col = 20: Data = TextBox1: GoSub DataSearch
    End Select




    Exit Sub




DataSearch:
    With SrcWks
        Set Rng = SrcWks.Range("A2:V2")
        Set RngEnd = .Cells(Rows.Count, Col).End(xlUp)
        Set RngEnd = IIf(RngEnd.Row < Rng.Row, Rng, RngEnd)
        Set Rng = .Range(Rng, RngEnd)
    End With




    Data = Trim(Data)
    Set FoundIt = Rng.Find(What:=Data, After:=Rng.Cells(1, 1), _
                           LookIn:=xlFormulas, LookAt:=CheckBox2.Value + 2, _
                           SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                           MatchCase:=CheckBox1.Value)
    If Not FoundIt Is Nothing Then
        FirstAddx = FoundIt.Address
        If CheckBox3.Value = False Then Exit Sub
        Set FoundIt = Rng.FindNext(FoundIt)
        R = R + 1












        With SrcWks
            If Not .AutoFilterMode Then MyData.AutoFilter
            MyData.AutoFilter Field:=Col, Criteria1:=strFind
            Set Rng = MyData.Columns(Col).Cells.SpecialCells(xlCellTypeVisible)
            Me.ListBox1.Clear
            For Each c In Rng
                With Me.ListBox1
                            
                    .AddItem c.Value
                    .List(.ListCount - 1, 0) = c.Offset(0, x).Address    'record number
                    .List(.ListCount - 1, 1) = c.Offset(0, x).Value  'surname
                    .List(.ListCount - 1, 2) = c.Offset(0, (x + 1)).Value  'first name
                    .List(.ListCount - 1, 3) = c.Offset(0, (x + 2)).Value    'DOB
                    .List(.ListCount - 1, 4) = c.Offset(0, (x + 3)).Value    'address
                    .List(.ListCount - 1, 5) = c.Offset(0, (x + 4)).Value    'date spoken to
                    .List(.ListCount - 1, 6) = c.Offset(0, (x + 5)).Value    'notes
                    .List(.ListCount - 1, 7) = c.Offset(0, (x + 6)).Value
                    .List(.ListCount - 1, 8) = c.Offset(0, (x + 7)).Value
                    .List(.ListCount - 1, 9) = c.Offset(0, (x + 8)).Value
                    '.List(.ListCount - 1, 10) = c.Offset(0, (x + 9)).Value
                    '.List(.ListCount - 1, 11) = c.Offset(0, (x + 10)).Value
                    '.List(.ListCount - 1, 12) = c.Offset(0, (x + 11)).Value
                    '.List(.ListCount - 1, 13) = c.Offset(0, (x + 12)).Value
                    '.List(.ListCount - 1, 14) = c.Offset(0, (x + 13)).Value
                    '.List(.ListCount - 1, 15) = c.Offset(0, (x + 14)).Value
                    '.List(.ListCount - 1, 16) = c.Offset(0, (x + 15)).Value
                    '.List(.ListCount - 1, 17) = c.Offset(0, (x + 16)).Value
                    '.List(.ListCount - 1, 18) = c.Offset(0, (x + 17)).Value
                    '.List(.ListCount - 1, 19) = c.Offset(0, (x + 18)).Value
                    '.List(.ListCount - 1, 20) = c.Offset(0, (x + 19)).Value
                    '.List(.ListCount - 1, 21) = c.Offset(0, (x + 20)).Value




                End With
            Next c
        End With
        
    Else
        MsgBox "No Match was found for '" & Data & " '", vbExclamation
    End If
    SrcWks.AutoFilterMode = False
    
    With Worksheets("Membership Sales")
    If Not .AutoFilterMode Then
    .Range("A1").AutoFilter
  End If
    End With


With Worksheets("Membership Sales")
.Protect Password:="taylor97"
End With




End Sub

 

[Jerry Sullivan]

I mocked up your setup, but I didn't get that same error. There's probably something slightly different in my mockup.

I suspect the error you're getting is due to some ambiguity in the way you are using variables and default properties.
The relevant parts of your existing code are:

   Dim Data As Variant
   Data = TextBox1
   Data = Trim(Data)

Less ambiguous would be...

   Dim Data as String
   Data= TextBox1.Value
   Data=Trim(Data)

I think your code could benefit from a rewrite instead of a series of modifications.
Would you mind if I took a pass at rewriting differently? (I don't want to diminish your learning experience, but it would take quite a bit of back and forth to indirectly work through those changes).

The only thing that isn't clear to me about your set up is the purpose of CheckBox3. Could you explain how that is supposed to be used?

 

[StartingOut]

Jerry I would be more then pleased to have you rewrite, I have been at this one for days now and just can't get it. as for checkbox3 I just wanted to return more then 1 row that may have the same search value such as a search for Smith, I may have John Smith and Mike Smith so I want to return both row date for John and Mike. If I could do without the CheckBoxes all together and still get the results, I would be happy.

 

[Jerry Sullivan]

Here's some code for you to try.

There are a number of differences in the approach, the most significant is using an array to collect the match row's data.

This eliminates the use of Autofilters to gather matching records.

Private Sub CommandButton1_Click()
'--Populates multi-column listbox with search results based on user input.

    Dim sFindText As String, sFirstAddr As String
    Dim i As Long, lFindCol As Long, lCol As Long, lRow As Long
    Dim rMyData As Range, rMySearchField As Range, cFound As Range
    Dim vArray() As Variant

    
    '--check User has entered Find_Text
    sFindText = Trim(TextBox1.Value)
    If sFindText = "" Then Exit Sub  'could add msgbox or label

    '--read user's choice of field to search
    '  (consider using a listbox instead of option buttons)
    With Frame1.Controls
        lFindCol = 5 'Default if no options buttons True
        For i = 0 To .Count - 1
            If .Item(i).Value = True Then
                Select Case .Item(i).Name
                    Case "OptionButton1": lFindCol = 5
                    Case "OptionButton2": lFindCol = 6
                    Case "OptionButton3": lFindCol = 1
                    Case "OptionButton4": lFindCol = 20
                End Select
                Exit For
            End If
        Next i
    End With

    With Worksheets("Membership Sales")
        Set rMyData = .Range("A2:V20")
        Set rMySearchField = rMyData.Resize(, 1).Offset(0, lFindCol - 1)
    End With

            
    With rMySearchField
        On Error Resume Next
        Set cFound = .Find(What:=sFindText, After:=.Cells(.Rows.Count), _
            LookIn:=xlFormulas, LookAt:=CheckBox2.Value + 2, _
            SearchDirection:=xlNext, MatchCase:=CheckBox1.Value)
        On Error GoTo 0

        If cFound Is Nothing Then
            MsgBox "No Match was found for '" & sFindText & " '", vbExclamation
        Else
            sFirstAddr = cFound.Address

            
            With rMyData
            '--set the boundaries of the array
                ReDim vArray(1 To .Columns.Count, 1 To .Rows.Count)
                Do Until cFound Is Nothing
                 '--add matching records from worksheet row to array
                    lRow = lRow + 1
                    For lCol = 1 To UBound(vArray, 1)
                        vArray(lCol, lRow) = .Cells(cFound.Row - .Row + 1, lCol + .Column - 1)
                    Next lCol

                    
                    Set cFound = rMySearchField.FindNext(After:=cFound)
                    If cFound.Address = sFirstAddr Then Exit Do
                Loop
                '--resize array to fit records stored.
                ReDim Preserve vArray(1 To .Columns.Count, 1 To lRow)
            End With

            
            '--place the array in the listbox
            With Me.ListBox1
                .ColumnCount = UBound(vArray, 1)
                .ColumnWidths = "50;;80;100" 'use this property to override default col widths
                .List = Application.Transpose(vArray)
            End With
        End If
    End With
End Sub

 

[StartingOut]

Hi Jerry, your rewrite is certainly simplified from my origina,l and works to get the results I was looking for to have more then just the 10 column's of data returned to the listbox1. Only thing I would ask is, in your code, if a search is done and 1 record is found that data returns to the first column in listbox1 vertically all in 1 column of the listbox and it it finds more then 1 match it then returns them to the total number of columns horizontally

Like this

Search for surname O"Brian returns 1 match list everything in first column of ListBox
O"Brian
Jan 1, 2012
Jan 1, 2013
123 Main St,
Someplace Avenue
Ontario
Canada
etc
etc

If a search is made for surname Smith and if 2 rows have the same found entry it returns as expected
Smith Jan 1, 2012 Jan 1, 2013 222 Sesame St, GreenValley Arizona etc etc
Smith Mar 3, 2012 Jun, 3, 2013 etc etc etc etc etc


Can 1 matching record that's found be placed in the listbox in the same way as if 2 are found, other then that it works awesome.