Searching a sheet and displaying on a userform

colinharwood

Active Member
Joined
Jul 27, 2002
Messages
440
Office Version
  1. 365
Platform
  1. Windows
Hi
I use the following code to search for a members surname in a worksheet, and having found it, display a userform to show the details from the row. I have duplicate surnames in the worksheet and I would like to add a spin button to the userform to be able to view duplicate surnames in the userform, in turn.
Is this possible.
thanks

Private Sub SearchForMember2()

Dim FindString As String
Dim rng As Range
Dim Number As Range
Dim SelectedCell As String

FindString = Member.Value
If Trim(FindString) <> "" Then
With Sheets("tmes members").Range("B:B")
Set rng = .Find(What:=FindString, _
After:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)

If Not rng Is Nothing Then
Application.GoTo rng
ActiveCell.Offset(rowOffset:=0, columnOffset:=-1).Select



End If
End With
Else: Exit Sub
End If

FindAMember2.Hide
DisplayMemberDetails
End Sub
 

Excel Facts

Best way to learn Power Query?
Read M is for (Data) Monkey book by Ken Puls and Miguel Escobar. It is the complete guide to Power Query.
Hi
I use the following code to search for a members surname in a worksheet, and having found it, display a userform to show the details from the row. I have duplicate surnames in the worksheet and I would like to add a spin button to the userform to be able to view duplicate surnames in the userform, in turn.
Is this possible.
thanks

Private Sub SearchForMember2()

Dim FindString As String
Dim rng As Range
Dim Number As Range
Dim SelectedCell As String

FindString = Member.Value
If Trim(FindString) <> "" Then
With Sheets("tmes members").Range("B:B")
Set rng = .Find(What:=FindString, _
After:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)

If Not rng Is Nothing Then
Application.GoTo rng
ActiveCell.Offset(rowOffset:=0, columnOffset:=-1).Select



End If
End With
Else: Exit Sub
End If

FindAMember2.Hide
DisplayMemberDetails
End Sub

I set up a Userform, see image.
The list of Controls is in the code below.

It assumes that the data is on a sheet named 'Data' but you can change that where indicated.

It assumes that the data starts in cell A1 and that it has a header row.

It demonstrates the idea. You will need to adapt it to your requirements.

It also has a scroll bar. See if you like that better.

The first text box is the criteria box.

1729436925414.png




VBA Code:
Option Explicit

Dim arrData() As Variant

 ' List Of Controls.
 
 ' TextBox   txtCriteria
 ' CommandButton  cmdSearch
 ' TextBox  txtTitle
 ' TextBox  txtForename
 ' TextBox txtSurname
 ' TextBox txtAddress1
 ' TextBox txtAddress2
 ' TextBox txtAddress3
 ' TextBox txtAddress4
 ' TextBox txtAddress5
 ' TextBox txtAddress6
 ' ScrollBar sbDisplayRows
 ' SpinButton spDisplayRows

Private Sub cmdSearch_Click()
Dim Ws As Worksheet
Dim strFormula As String
Dim rngData As Range
Dim Q As String
Dim rngSearch As Range
Dim intCount As Integer

  ActiveWorkbook.Save
    
  Call subDisplayBlank
  
  Q = Chr(34)

  If Len(Trim(Me.txtCriteria)) = 0 Then
    Exit Sub
  End If
  
  ' Change the worksheet name here.
  Set Ws = ActiveWorkbook.Sheets("Data")
  
  ' Assumes that the data starts in cell A1 and that it has a header row.
  With Ws.Range("A1").CurrentRegion
  
    Set rngData = .Offset(1, 0).Resize(.Rows.Count, .Columns.Count)
  
  End With
  
  With rngData
  
    intCount = WorksheetFunction.CountIf(Range(Ws.Name & "!" & .Columns(11).Address), Me.txtCriteria)
        
    If intCount > 0 Then
  
      ' The numbers at the end of this split line of code represent the column numbers in the data range
      ' that are to be used to populate the userform.
      strFormula = "=CHOOSECOLS(FILTER(" & Ws.Name & "!" & .Address & "," & Ws.Name & "!" & _
        .Columns(11).Address & "=" & Q & Me.txtCriteria & Q & "," & Q & Q & "),9,10,11,22,23,24,25,26,27)"
      ' The number 11 above >>(Columns(11))<< represents the column to be searched.
      
      ' Data is assigned to an array.
      arrData = Evaluate(Mid(strFormula, 2))
      
      ' Scroll Bar settings.
      With Me.sbDisplayRows
        .ProportionalThumb = False
        .Min = 1
        .Max = intCount
        .LargeChange = intCount + 1
        .Value = 1
      End With
      
      ' Spin Button settings.
      With Me.spDisplayRows
        .Min = 1
        .Max = intCount
        .Value = 1
      End With
      
    End If
        
  End With
      
End Sub

' Populate text boxes on the Userform from the array.
Private Sub subDisplayData(intIndex As Integer)

  Me.txtTitle = arrData(intIndex, 1)
  Me.txtForename = arrData(intIndex, 2)
  Me.txtSurname = arrData(intIndex, 3)
  Me.txtAddress1 = arrData(intIndex, 4)
  Me.txtAddress2 = arrData(intIndex, 5)
  Me.txtAddress3 = arrData(intIndex, 6)
  Me.txtAddress4 = arrData(intIndex, 7)
  Me.txtAddress5 = arrData(intIndex, 8)
  Me.txtAddress6 = arrData(intIndex, 9)
  
  Me.Caption = "Displaying " & intIndex & " of " & UBound(arrData) & "."
  
End Sub

' Blank the text boxes.
Private Sub subDisplayBlank()

  Me.txtTitle = ""
  Me.txtForename = ""
  Me.txtSurname = ""
  Me.txtAddress1 = ""
  Me.txtAddress2 = ""
  Me.txtAddress3 = ""
  Me.txtAddress4 = ""
  Me.txtAddress5 = ""
  Me.txtAddress6 = ""
  
End Sub

' Scroll Bar change event handler.
Private Sub sbDisplayRows_Change()

  Call subDisplayData(Me.sbDisplayRows.Value)
  
  Me.cmdSearch.SetFocus
  
End Sub

' Spin Button change event handler.
Private Sub spDisplayRows_Change()

  Call subDisplayData(Me.spDisplayRows.Value)
  
  Me.cmdSearch.SetFocus
  
End Sub
 
Upvote 0
Solution
That's great, Thanks a lot, a little bit of customisation and it does just what I want it to
 
Upvote 0
One more question please.
Having searched and found a member, if i change the search criteria and search again, the form entries all go blank.
Is there a way to be able to set another command button to search again.
I have tried unloading and reloading the form, but it doesn't seem to work.
 
Upvote 0
One more question please.
Having searched and found a member, if i change the search criteria and search again, the form entries all go blank.
Is there a way to be able to set another command button to search again.
I have tried unloading and reloading the form, but it doesn't seem to work.
Only one button is needed.

I've fixed the problem you had plus another when only one row was found.

Copy and paste this code to replace the previous version but remember to apply the changes you made.

VBA Code:
Option Explicit

Dim arrData() As Variant

 ' List Of Controls.
 
 ' TextBox   txtCriteria
 ' CommandButton  cmdSearch
 ' TextBox  txtTitle
 ' TextBox  txtForename
 ' TextBox txtSurname
 ' TextBox txtAddress1
 ' TextBox txtAddress2
 ' TextBox txtAddress3
 ' TextBox txtAddress4
 ' TextBox txtAddress5
 ' TextBox txtAddress6
 ' ScrollBar sbDisplayRows
 ' SpinButton spDisplayRows

Private Sub cmdSearch_Click()
Dim Ws As Worksheet
Dim strFormula As String
Dim rngData As Range
Dim Q As String
Dim rngSearch As Range
Dim intCount As Integer

  ActiveWorkbook.Save
    
  Call subDisplayBlank
  
  Q = Chr(34)

  If Len(Trim(Me.txtCriteria)) = 0 Then
    Exit Sub
  End If
  
  ' Change the worksheet name here.
  Set Ws = ActiveWorkbook.Sheets("Data")
  
  ' Assumes that the data starts in cell A1 and that it has a header row.
  With Ws.Range("A1").CurrentRegion
  
    Set rngData = .Offset(1, 0).Resize(.Rows.Count, .Columns.Count)
  
  End With
  
  With rngData
  
    intCount = WorksheetFunction.CountIf(Range(Ws.Name & "!" & .Columns(11).Address), Me.txtCriteria)
   
    Me.spDisplayRows.Enabled = intCount > 1
   
    If intCount > 0 Then
  
      ' The numbers at the end of this split line of code represent the column numbers in the data range
      ' that are to be used to populate the userform.
      strFormula = "=CHOOSECOLS(FILTER(" & Ws.Name & "!" & .Address & "," & Ws.Name & "!" & _
        .Columns(11).Address & "=" & Q & Me.txtCriteria & Q & "," & Q & Q & "),9,10,11,22,23,24,25,26,27)"
      ' The number 11 above >>(Columns(11))<< represents the column to be searched.
      
      ' Data is assigned to an array.
      arrData = Evaluate(Mid(strFormula, 2))
      
      ' Spin Button settings.
      Application.EnableEvents = False
      With Me.spDisplayRows
        .Min = 1
        .Max = intCount
        .Value = 1
      End With
      Application.EnableEvents = True
      
      Call subDisplayData(1)
      
    End If
        
  End With
      
End Sub

' Populate text boxes on the Userform from the array.
Private Sub subDisplayData(intIndex As Integer)
Dim intDim As Integer
Dim arrTemp() As Variant
Dim i As Integer

  On Error Resume Next
  intDim = UBound(arrData, 2)
  On Error GoTo 0
  
  ' If only one row is found then need to convert fron
  ' a 1D array to a 2D array.
  If intDim = 0 Then
    arrTemp = arrData
    ReDim arrData(1, UBound(arrTemp))
    For i = 1 To UBound(arrTemp)
      arrData(1, i) = arrTemp(i)
    Next i
  End If
  
  Me.txtTitle = arrData(intIndex, 1)
  Me.txtForename = arrData(intIndex, 2)
  Me.txtSurname = arrData(intIndex, 3)
  Me.txtAddress1 = arrData(intIndex, 4)
  Me.txtAddress2 = arrData(intIndex, 5)
  Me.txtAddress3 = arrData(intIndex, 6)
  Me.txtAddress4 = arrData(intIndex, 7)
  Me.txtAddress5 = arrData(intIndex, 8)
  Me.txtAddress6 = arrData(intIndex, 9)
  
  Me.Caption = "Displaying " & intIndex & " of " & UBound(arrData) & "."
  
End Sub

' Blank the text boxes.
Private Sub subDisplayBlank()

  Me.txtTitle = ""
  Me.txtForename = ""
  Me.txtSurname = ""
  Me.txtAddress1 = ""
  Me.txtAddress2 = ""
  Me.txtAddress3 = ""
  Me.txtAddress4 = ""
  Me.txtAddress5 = ""
  Me.txtAddress6 = ""
  
End Sub

' Spin Button change event handler.
Private Sub spDisplayRows_Change()

  Call subDisplayData(Me.spDisplayRows.Value)
  
  Me.cmdSearch.SetFocus
  
End Sub
 
Upvote 0
Thanks a lot.
Now for something I cannot ubderstand.
To try this out, I started a new workbook and copied the sheet of data from my existing file.
Everything all works fine, so I have exported the form, and then imported into my original workbook, and changed the references accordingly, but now it stops when the line:
intCount = WorksheetFunction.CountIf(Range(Ws.Name & "!" & .Columns(2).Address), Me.txtSearchCriteria).
is reached.
Any idea why
 
Upvote 0
Thanks a lot.
Now for something I cannot ubderstand.
To try this out, I started a new workbook and copied the sheet of data from my existing file.
Everything all works fine, so I have exported the form, and then imported into my original workbook, and changed the references accordingly, but now it stops when the line:
intCount = WorksheetFunction.CountIf(Range(Ws.Name & "!" & .Columns(2).Address), Me.txtSearchCriteria).
is reached.
Any idea why

Does it just hang or produce an error?
If the latter then what error does it produce?

You can drag forms and modules between open workbooks instead of exporting and importing.
Do this in the VBE Editor Project Explorer.

If I want to create a copy I often just save the workbook under a different name and delete what I don't need.
 
Upvote 0
it produces the error shown in screenshot 1, and when you open the vba editor you get what is shown in screenshot
 

Attachments

  • Screenshot_1.jpg
    Screenshot_1.jpg
    45.9 KB · Views: 9
  • Screenshot_2.jpg
    Screenshot_2.jpg
    57.4 KB · Views: 9
Upvote 0
it produces the error shown in screenshot 1, and when you open the vba editor you get what is shown in screenshot
Can you remove the space in the worksheet name?

You could put an underscore or a hyphen in place of the space.
 
Upvote 0

Forum statistics

Threads
1,224,595
Messages
6,179,798
Members
452,943
Latest member
Newbie4296

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