Searching a sheet and displaying on a userform

[colinharwood]

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

 

[HighAndWilder]

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.

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

 

[colinharwood]

That's great, Thanks a lot, a little bit of customisation and it does just what I want it to

 

[HighAndWilder]

That's great, Thanks a lot, a little bit of customisation and it does just what I want it to

That's good. Assigning the data to an array by evaluating the formula is the key.

 

[colinharwood]

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.

 

[HighAndWilder]

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.

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

 

[colinharwood]

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

 

[HighAndWilder]

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.

 

[colinharwood]

it produces the error shown in screenshot 1, and when you open the vba editor you get what is shown in screenshot

 

[HighAndWilder]

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.