UserForm search VBA

VbaHell

Well-known Member
Joined
Jan 30, 2011
Messages
1,220
Hello all

I have a userform with 33 TextBoxes populating a workbook columns "A:AG"
Is it possible to use a command button and search the whole workbook "A:AG" and populate the text boxes with the result and page through using a spin button
As help on this would be great please
 

Excel Facts

Create a chart in one keystroke
Select the data and press Alt+F1 to insert a default chart. You can change the default chart to any chart type
Here's how I understand what you wanted:

1. Insert a (blank) form (Alt F11 | Insert | Userform)
2. Insert this code into the userform's code module
3. Have data sheet as active sheet (displayed)
4. Show form
5. Test
6. Let me know how it worked

Code:
Dim WithEvents bSB As MSForms.SpinButton


Private Sub bSB_Change()
    For i = 1 To 33
        Me.Controls("TB" & Right("000" & i, 3)) = Cells(bSB.Value, i)
    Next i
End Sub

Private Sub UserForm_Initialize()
    Me.Width = 475
    
    Me.Height = 400
    ct = 1
    For j = 1 To 10
        For k = 1 To 5
            With Me.Controls.Add("Forms.TextBox.1", "TB" & Right("000" & ct, 3))
                .Left = 10 + (k - 1) * 90
                .Top = 30 + (j - 1) * 30
                .Width = 90
                .Height = 20
                .Text = .Name
            End With
            ct = ct + 1
            If ct > 33 Then Exit For
        Next
            If ct > 33 Then
                Me.Height = j * 30 + 50
                Exit For
            End If
    Next
    Set bSB = Me.Controls.Add("Forms.SpinButton.1", "SB1")
    With bSB
        lr = Cells(Rows.Count, 1).End(xlUp).Row
        .Max = Cells(Rows.Count, 1).End(xlUp).Row
        .Min = 1
        .Value = 1
        .Top = 5
        .Left = 190
        .Width = 90
        .Height = 20
    End With
End Sub
 
Upvote 0
Hello Tlowry

Many thanks for responding to my post

Below is the code I am using to find records that match in TextBox1, What I would like to do if possible is search for records across all the textboxes using textbox34 and then use my spin button to review the answers, I do not even know if this is possible

Private Sub cmbFind_Click()
Dim strFind As String 'what to find
Dim FirstAddress As String
Dim rSearch As Range 'range to search
Set rSearch = Sheet1.Range("a2", Range("a65536").End(xlUp))
Dim f As Integer
imgFolder = ThisWorkbook.Path & Application.PathSeparator & "images" & Application.PathSeparator
strFind = Me.TextBox1.Value 'what to look for
With rSearch
Set c = .Find(strFind, LookIn:=xlValues)
If Not c Is Nothing Then 'found it
c.Select
With Me 'load entry to form
.TextBox2.Value = c.Offset(0, 1).Value
.TextBox3.Value = c.Offset(0, 2).Value
.TextBox4.Value = c.Offset(0, 3).Value
.TextBox5.Value = c.Offset(0, 4).Value
.TextBox6.Value = c.Offset(0, 5).Value
.TextBox7.Value = c.Offset(0, 6).Value
.TextBox8.Value = c.Offset(0, 7).Value
.TextBox9.Value = c.Offset(0, 8).Value
.TextBox10.Value = c.Offset(0, 9).Value
.TextBox11.Value = c.Offset(0, 10).Value
.TextBox12.Value = c.Offset(0, 11).Value
.TextBox13.Value = c.Offset(0, 12).Value
.TextBox14.Value = c.Offset(0, 13).Value
.TextBox15.Value = c.Offset(0, 14).Value
.TextBox16.Value = c.Offset(0, 15).Value
.TextBox17.Value = c.Offset(0, 16).Value
.TextBox18.Value = c.Offset(0, 17).Value
.TextBox19.Value = c.Offset(0, 18).Value
.TextBox20.Value = c.Offset(0, 19).Value
.TextBox21.Value = c.Offset(0, 20).Value
.TextBox22.Value = c.Offset(0, 21).Value
.TextBox23.Value = c.Offset(0, 22).Value
.TextBox24.Value = c.Offset(0, 23).Value
.TextBox25.Value = c.Offset(0, 24).Value
.TextBox26.Value = c.Offset(0, 25).Value
.TextBox27.Value = c.Offset(0, 26).Value
.TextBox28.Value = c.Offset(0, 27).Value
.TextBox29.Value = c.Offset(0, 28).Value
.TextBox30.Value = c.Offset(0, 29).Value
.TextBox31.Value = c.Offset(0, 30).Value
.TextBox32.Value = c.Offset(0, 31).Value
.TextBox33.Value = c.Offset(0, 32).Value

'BBBBBBBBBBBBBBBBBBBBB
sFileName = c.Offset(0, 4).Value
LoadPic
.cmbAmend.Enabled = True 'allow amendment or
.cmbDelete.Enabled = True 'allow record deletion
.cmbAdd.Enabled = False 'don't want to duplicate record
.Width = frmMaxWidth
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.Height = frmMax
End If
Else: MsgBox strFind & " not listed" 'search failed
End If
End With
If Sheet1.AutoFilterMode Then Sheet1.Range("A8").AutoFilter
End Sub
 
Upvote 0
Same instructions

Code:
Dim WithEvents bSB As MSForms.SpinButton
Dim WithEvents bTBFind As MSForms.TextBox
Public arr
Const EnterMessage = "<-- Enter search criteria"
Private Sub bSB_Change()
    On Local Error GoTo outtahere
    UserForm1.Controls("lblCount").Caption = EnterMessage
    For i = 1 To 33
        With Me.Controls("TB" & Right("000" & i, 3))    ' display selected data
            .BackColor = bTBFind.BackColor              ' and color tb(s) that meet criteria
            .Value = Cells(arr(bSB.Value - 1), i)       ' value
            If InStr(.Text, bTBFind.Text) > 0 Then .BackColor = &HC0FFC0 ' color
        End With
    Next i
    ' change x of x label
    UserForm1.Controls("lblCount").Caption = bSB.Value & " of " & UBound(arr) + 1
    Exit Sub
outtahere:  ' error (not found)clear all tbs
      For i = 1 To 33
        With Me.Controls("TB" & Right("000" & i, 3))
            .BackColor = bTBFind.BackColor
            .Value = ""
        End With
    Next
End Sub

Private Sub bTBFind_Change()
    arr = DisplayRecords(bTBFind.Text)  ' TB has changed, find data
    bSB.Max = UBound(arr) + 1           ' arr has the list of rows to display
    bSB.Value = 1                       ' set spin value to first record
    bSB_Change                          ' force SpinButton change event
End Sub
Private Sub UserForm_Initialize()   ' Set up form from blank...
    Me.Width = 475
    Me.Height = 275
    ct = 1
    Set bTBFind = Me.Controls.Add("Forms.TextBox.1", "TBFind")
    With bTBFind
        .Left = 10
        .Top = 10
        .Width = 90
        .Height = 20
    End With
    For j = 1 To 10
        For k = 1 To 5
            With Me.Controls.Add("Forms.TextBox.1", "TB" & Right("000" & ct, 3))
                .Left = 10 + (k - 1) * 90
                .Top = 40 + (j - 1) * 30
                .Width = 90
                .Height = 20
                .Text = .Name
            End With
            ct = ct + 1
            If ct > 33 Then Exit For
        Next
        If ct > 33 Then Exit For
    Next
        Me.Controls.Add "Forms.Label.1", "lblCount"
        With UserForm1.Controls("lblCount")
            .Left = bTBFind.Left + bTBFind.Width + 10
            .Top = 15
            .Width = 200
            .Height = 15
        End With
    Set bSB = Me.Controls.Add("Forms.SpinButton.1", "SB1")
    With bSB
        lr = Cells(Rows.Count, 1).End(xlUp).Row
        .Max = Cells(Rows.Count, 1).End(xlUp).Row
        .Min = 1
        .Value = 1
        .Top = 10
        .Width = 60
        .Height = 20
        .Left = 0.5 * (Me.Width - .Width)
    End With
End Sub
Function DisplayRecords(Optional sVal = "") As Variant
    Dim i
    If sVal = "" Then
        ReDim arr(ActiveSheet.UsedRange.Rows.Count - 1)
        For i = 1 To ActiveSheet.UsedRange.Rows.Count - 1
            arr(i) = i
        Next
        DisplayRecords = arr
        Exit Function
    End If
    Dim d:  Set d = CreateObject("Scripting.Dictionary")
    Dim rng As Range: Set rng = ActiveSheet.UsedRange
    Dim firstaddress, fnd
    d.removeall
    With ActiveSheet.Cells
        Set fnd = .Find(What:=CStr(sVal), LookIn:=xlFormulas, _
            LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
        If Not fnd Is Nothing Then
            firstaddress = fnd.Address
            Do
                If d.exists(fnd.Row) = False Then
                    d.Add fnd.Row, fnd.Row
                End If
                Set fnd = .FindNext(fnd)
            Loop While Not fnd Is Nothing And fnd.Address <> firstaddress
        End If
    End With
    DisplayRecords = d.items
End Function
 
Upvote 0
Hello,

I REALLY REALLY like this setup. Is there anyway to modify this to have 3 text boxes for search parameters adn then the results display in a listbox?
 
Upvote 0

Forum statistics

Threads
1,214,636
Messages
6,120,664
Members
448,976
Latest member
sweeberry

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top