Searching From a Userform and showing results in a ListBox

Mark BMS

New Member
Joined
Jan 11, 2016
Messages
22
Hi All

I am using Excel 2016

I am in the final stages of creating a userform which adds data from 31 TextBoxes to a workbook. This all works fine.

My data is in Sheet1, the first 3 rows are references for textboxes and labels to help me build the userform. I have data headings in Row 4 and my actual data starts in Row 5. tb1 post data to column 1, tb2 to Col 2 etc all the way to tb31 to Col 31

I have been adapting the code from a free workbook published by Roy Cox (just wanted to give credit where its due)

I am having problems adapting the the search and display function. The original workbook had 5 column where as mine has 31. I have grouped the subs which I think are causing me problems at the top of the code window so I can post more easily. There are more subs but these are all working ok

When cbFind is clicked I get a run-time error '380' Could not set the list property. Invalid property value

Debugging highlights line
Code:
.List(.ListCount - 1, 10) = c.Offset(0, 10).Value
in cbFind Click()


The following code is where I think my issues are

Code:
Option Explicit
Dim Ws As Worksheet
Dim MyData As Range, c As Range, rFound As Range, rng As Range
Dim r As Long
Const frmMax As Long = 1030
Const frmHt As Long = 616
Const frmWidth As Long = 427
Dim oCtrl As MSForms.Control


Private Sub UserForm_Initialize()
'change sheet name and Range here
    Set Ws = Sheet1
    Set MyData = Ws.Range("a4").CurrentRegion   'database
    With Me
        .Caption = "Site Password Database"    'userform caption
        .Height = frmHt
        .Width = frmWidth
        .ScrollBar1.Max = MyData.Rows.Count
        .ScrollBar1.Min = 2
    End With
    
SetLabels


ClearControls


    
End Sub


Private Sub cbFind_Click()
    Dim strFind As String    'what to find
    Dim FirstAddress As String
    Dim f As Integer
    
    strFind = Me.tb1.Value    'what to look for


    With MyData
    .AutoFilter
        Set c = .Find(strFind, LookIn:=xlValues)
        If Not c Is Nothing Then    'found it


            With Me    'load entry to form
                .tb2.Value = c.Offset(0, 1).Value
                .tb3.Value = c.Offset(0, 2).Value
                .tb4.Value = c.Offset(0, 3).Value
                .tb5.Value = c.Offset(0, 4).Value
                .tb6.Value = c.Offset(0, 5).Value
                .tb7.Value = c.Offset(0, 6).Value
                
                If c.Offset(0, 7).Value = "Yes" Then .optYes = True
                If c.Offset(0, 7).Value = "No" Then .optNo = True
                
                .tb9.Value = c.Offset(0, 8).Value
                .tb10.Value = c.Offset(0, 9).Value
                .tb11.Value = c.Offset(0, 10).Value
                .tb12.Value = c.Offset(0, 11).Value
                .tb13.Value = c.Offset(0, 12).Value
                .tb14.Value = c.Offset(0, 13).Value
                .tb15.Value = c.Offset(0, 14).Value
                .tb16.Value = c.Offset(0, 15).Value
                .tb17.Value = c.Offset(0, 16).Value
                .tb18.Value = c.Offset(0, 17).Value
                .tb19.Value = c.Offset(0, 18).Value
                .tb20.Value = c.Offset(0, 19).Value
                .tb21.Value = c.Offset(0, 20).Value
                .tb22.Value = c.Offset(0, 21).Value
                .tb23.Value = c.Offset(0, 22).Value
                .tb24.Value = c.Offset(0, 23).Value
                .tb25.Value = c.Offset(0, 24).Value
                .tb26.Value = c.Offset(0, 25).Value
                .tb27.Value = c.Offset(0, 26).Value
                .tb28.Value = c.Offset(0, 27).Value
                .tb29.Value = c.Offset(0, 28).Value
                .tb30.Value = c.Offset(0, 29).Value
                .tb31.Value = c.Offset(0, 30).Value
               
                .cbAmend.Enabled = True     'allow amendment or
                .cbDelete.Enabled = True    'allow record deletion
                .cbAdd.Enabled = False      'don't want to duplicate record
                
                r = c.Row
                f = 0
            End With
            FirstAddress = c.Address
            Do
                f = f + 1    'count number of matching records
                Set c = .FindNext(c)
            Loop While Not c Is Nothing And c.Address <> FirstAddress
            If f > 1 Then
                Select Case MsgBox("There are " & f & " instances of " & strFind, vbOKCancel Or vbExclamation Or vbDefaultButton1, "Multiple entries")


                Case vbOK
                    FindAll
                Case vbCancel
                    'do nothing
                End Select
                Me.Width = frmMax


            End If
        Else: MsgBox strFind & " not listed"    'search failed
        End If
    End With


End Sub


Private Sub ListBox1_Click()
Set c = Nothing
    With Me.ListBox1


        If .ListIndex = -1 Then    'not selected
            MsgBox " No selection made"
        ElseIf .ListIndex >= 1 Then    'User has selected
            r = Val(.List(.ListIndex, .ColumnCount - 1))
        End If
    End With


    With Me
        .tb1.Value = .ListBox1.List(.ListBox1.ListIndex, 0)
        .tb2.Value = .ListBox1.List(.ListBox1.ListIndex, 1)
        .tb3.Value = .ListBox1.List(.ListBox1.ListIndex, 2)
        .tb4.Value = .ListBox1.List(.ListBox1.ListIndex, 3)
        .tb5.Value = .ListBox1.List(.ListBox1.ListIndex, 4)
        .tb6.Value = .ListBox1.List(.ListBox1.ListIndex, 5)
        .tb7.Value = .ListBox1.List(.ListBox1.ListIndex, 6)
        .tb9.Value = .ListBox1.List(.ListBox1.ListIndex, 8)
        .tb10.Value = .ListBox1.List(.ListBox1.ListIndex, 9)
        .tb11.Value = .ListBox1.List(.ListBox1.ListIndex, 10)
        .tb12.Value = .ListBox1.List(.ListBox1.ListIndex, 11)
        .tb13.Value = .ListBox1.List(.ListBox1.ListIndex, 12)
        .tb14.Value = .ListBox1.List(.ListBox1.ListIndex, 13)
        .tb15.Value = .ListBox1.List(.ListBox1.ListIndex, 14)
        .tb16.Value = .ListBox1.List(.ListBox1.ListIndex, 15)
        .tb17.Value = .ListBox1.List(.ListBox1.ListIndex, 16)
        .tb18.Value = .ListBox1.List(.ListBox1.ListIndex, 17)
        .tb19.Value = .ListBox1.List(.ListBox1.ListIndex, 18)
        .tb20.Value = .ListBox1.List(.ListBox1.ListIndex, 19)
        .tb21.Value = .ListBox1.List(.ListBox1.ListIndex, 20)
        .tb22.Value = .ListBox1.List(.ListBox1.ListIndex, 21)
        .tb23.Value = .ListBox1.List(.ListBox1.ListIndex, 22)
        .tb24.Value = .ListBox1.List(.ListBox1.ListIndex, 23)
        .tb25.Value = .ListBox1.List(.ListBox1.ListIndex, 24)
        .tb26.Value = .ListBox1.List(.ListBox1.ListIndex, 25)
        .tb27.Value = .ListBox1.List(.ListBox1.ListIndex, 26)
        .tb28.Value = .ListBox1.List(.ListBox1.ListIndex, 27)
        .tb29.Value = .ListBox1.List(.ListBox1.ListIndex, 28)
        .tb30.Value = .ListBox1.List(.ListBox1.ListIndex, 29)
        .tb31.Value = .ListBox1.List(.ListBox1.ListIndex, 30)
        
        If ListBox1.List(.ListBox1.ListIndex, 8) = "Yes" Then
            .optYes = True
        Else: .optNo = True
        End If


        .cbAmend.Enabled = True      'allow amendment or
        .cbDelete.Enabled = True     'allow record deletion
        .cbAdd.Enabled = False       'don't want duplicate
        
    End With


End Sub


Sub FindAll()


    Dim wesTemp As Worksheet
    Dim strFind As String    'what to find


    strFind = Me.tb1.Value


    If Not Ws.AutoFilterMode Then MyData.AutoFilter


    MyData.AutoFilter Field:=1, Criteria1:=strFind


    Me.ListBox1.Clear
    For Each c In MyData.Columns(1).SpecialCells(xlCellTypeVisible)
        With ListBox1
            .AddItem c.Value
            .List(.ListCount - 1, 1) = c.Offset(0, 1).Value
            .List(.ListCount - 1, 2) = c.Offset(0, 2).Value
            .List(.ListCount - 1, 3) = c.Offset(0, 3).Value
            .List(.ListCount - 1, 4) = c.Offset(0, 4).Value
            .List(.ListCount - 1, 5) = c.Offset(0, 5).Value
            .List(.ListCount - 1, 6) = c.Offset(0, 6).Value
            .List(.ListCount - 1, 7) = c.Offset(0, 7).Value
            .List(.ListCount - 1, 8) = c.Offset(0, 8).Value
            .List(.ListCount - 1, 9) = c.Offset(0, 9).Value
            .List(.ListCount - 1, 10) = c.Offset(0, 10).Value
            .List(.ListCount - 1, 11) = c.Offset(0, 11).Value
            .List(.ListCount - 1, 12) = c.Offset(0, 12).Value
            .List(.ListCount - 1, 13) = c.Offset(0, 13).Value
            .List(.ListCount - 1, 14) = c.Offset(0, 14).Value
            .List(.ListCount - 1, 15) = c.Offset(0, 15).Value
            .List(.ListCount - 1, 16) = c.Offset(0, 16).Value
            .List(.ListCount - 1, 17) = c.Offset(0, 17).Value
            .List(.ListCount - 1, 18) = c.Offset(0, 18).Value
            .List(.ListCount - 1, 19) = c.Offset(0, 19).Value
            .List(.ListCount - 1, 20) = c.Offset(0, 20).Value
            .List(.ListCount - 1, 21) = c.Offset(0, 21).Value
            .List(.ListCount - 1, 22) = c.Offset(0, 22).Value
            .List(.ListCount - 1, 23) = c.Offset(0, 23).Value
            .List(.ListCount - 1, 24) = c.Offset(0, 24).Value
            .List(.ListCount - 1, 25) = c.Offset(0, 25).Value
            .List(.ListCount - 1, 26) = c.Offset(0, 26).Value
            .List(.ListCount - 1, 27) = c.Offset(0, 27).Value
            .List(.ListCount - 1, 28) = c.Offset(0, 28).Value
            .List(.ListCount - 1, 29) = c.Offset(0, 29).Value
            .List(.ListCount - 1, 30) = c.Offset(0, 30).Value
            .List(.ListCount - 1, 31) = c.Offset(0, 31).Value


        End With
    Next c


End Sub

I hope I've included enough information.
Any help would be greatly appreciate
 

Some videos you may like

Excel Facts

How can you turn a range sideways?
Copy the range. Select a blank cell. Right-click, Paste Special, then choose Transpose.

dmt32

Well-known Member
Joined
Jul 3, 2012
Messages
6,099
Office Version
  1. 2019
Platform
  1. Windows
Hi,
As you are using Autofilter, you should only need the one procedure to find all matching records in your search.
Also, consider placing matching records to an array to populate your listbox. Saves all those lines of code.

Following untested but hopefully will do what you want

Code:
Sub cbFind_Click()
    Dim strFind As String
    Dim FilterRange As Range, cell As Range
    Dim r As Long, c As Long, FilterCount As Long
    Dim arr() As Variant
    
'what to find
    strFind = Me.tb1.Value
    
    If Not ws.AutoFilterMode Then myData.AutoFilter
    
    myData.AutoFilter Field:=1, Criteria1:=strFind
    
    Set FilterRange = ws.AutoFilter.Range
    
'get count of matching records
    FilterCount = FilterRange.Columns(1).SpecialCells(xlCellTypeVisible).Count - 1
    
    If FilterCount > 0 Then
        
'remove header row
        Set FilterRange = FilterRange.Offset(1, 0).Resize(FilterRange.Rows.Count - 1)
        
        With Me.ListBox1
            .Clear
'size array
            ReDim arr(1 To FilterCount, 1 To .ColumnCount)
            
'loop each filtered row
            For Each cell In FilterRange.Columns(1).SpecialCells(xlCellTypeVisible).Rows
'array index
                r = r + 1
'loop row columns
                For c = 1 To .ColumnCount
'build array
                    arr(r, c) = cell.Offset(, c - 1)
                Next c
            Next cell
'output array to listbox
                    .List = arr
        End With
                
    Else
'inform user
          MsgBox strFind & Chr(10) & "Record Not Found", 48, "Not Found"
                
    End If
                 
End Sub

I have added some additional code to check that there is at least, one record that matches your a search.

Dave
 
Last edited:

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
12,593
Office Version
  1. 2007
Platform
  1. Windows
Only to comment the error happened. With the .Add method, you can only add 10 columns, from column 0 to column 9. When you try to add column 11, it sends you the error.
 

Watch MrExcel Video

Forum statistics

Threads
1,109,204
Messages
5,527,401
Members
409,760
Latest member
zeeshansyed

This Week's Hot Topics

Top