Setting up Previous and next Buttons for search results

Bill Williamson

Board Regular
Joined
Oct 7, 2019
Messages
124
Hello everyone,
I have my userform almost done. I am able to do my searches, a it sorts the data properly. It will show first match in my form, but have added Prev and Next Buttons to look through similar matches. I am not sure how to get it to work with the search results.
Here is a screen shot of my sorted Data.https://www.dropbox.com/s/l18ksc0750y4xr7/Screenshot 2019-10-24 12.13.17.png?dl=0
Screenshot%202019-10-24%2012.08.07.png


Screenshot%202019-10-24%2012.13.17.png
Here is a link to my file,
https://www.dropbox.com/s/jvz52b3gjvo2r9x/BOM Review Setup3.xlsm?dl=0


Any ideas are appreciated.

My Code,

Code:
Dim wsData As Worksheet
Dim Fnd As Range
Const xlUpdate As Integer = 2


Private Sub CancelButton_Click()
Unload Me
End Sub


Private Sub CBNext_Click()


End Sub


Private Sub CBPrev_Click()


End Sub


Private Sub ClearButton_Click()
'Sub Clearform()
Dim ctrl As msforms.Control
    For Each ctrl In Me.Controls
        Select Case TypeName(ctrl)
        Case "TextBox"
            ctrl.Text = ""
        Case "ComboBox"
            ctrl.ListIndex = -1
        Case "CheckBox"
            ctrl.Value = False
    End Select
Next
End Sub


Private Sub CMDSearch_Click()
    Dim i As Integer
    With wsData
        If .AutoFilterMode Then .AutoFilterMode = False
        If Customer.Value <> "" Then .Range("A1").AutoFilter 1, Me.Customer.Value
        If CSONumber.Value <> "" Then .Range("A1").AutoFilter 2, Me.CSONumber.Value
        If JobNumber.Value <> "" Then .Range("A1").AutoFilter 3, Me.JobNumber.Value
        On Error Resume Next
        Set Fnd = .Range("A2:A" & Rows.Count).SpecialCells(xlVisible)(1)
        On Error GoTo 0
        
        If Fnd Is Nothing Then
            MsgBox "Search term not found", 48, "Not Found"
            Me.CMDUpdate.Enabled = False
        Else
            
            For i = 1 To 15
                With Me.Controls(Choose(i, "Customer", "CSONumber", "JobNumber", _
                                            "PCWeldType", "PCWeldGrind", "PCFinish", _
                                            "NonPCWeld", "NonPCGrind", "NonPCFinish", _
                                            "BRReview", "BOMReview", "DimReview", _
                                            "WeldReview", "Apperance", "Complete"))
                    If i < 10 Then
                        .Text = Fnd.Offset(, i - 1).Value
                    Else
                        .Value = CBool(LCase(Fnd.Offset(, i - 1).Value) = "yes")
                    End If
                End With
            Next i
                
            Me.CMDUpdate.Enabled = True
            End If
'Turns off auto filter, shows all data
 '           .AutoFilterMode = False
            
        End With
End Sub




Private Sub CMDUpdate_Click()
   AddUpdateRecord Fnd.Row, xlUpdate
End Sub


Sub AddUpdateRecord(ByVal RecordRow As Long, ByVal Action As Integer)
    Dim i As Integer
    Dim Answer As VbMsgBoxResult
    
    If Action = xlUpdate Then
'Update Records
        Answer = MsgBox("Are you sure you want to update?", vbYesNo + vbQuestion, "Update Record")
        If Answer = vbNo Then Exit Sub
    End If
    
    With wsData
        For i = 1 To 9
            .Cells(RecordRow, i).Value = Choose(i, Customer.Value, CSONumber.Value, JobNumber.Value, _
                                                   PCWeldType.Value, PCWeldGrind.Value, PCFinish.Value, _
                                                   NonPCWeld.Value, NonPCGrind.Value, NonPCFinish.Value)
        Next i
    
            .Cells(RecordRow, 10).Value = IIf(BRReview.Value, "Yes", "No")
            .Cells(RecordRow, 11).Value = IIf(BOMReview.Value, "Yes", "No")
            .Cells(RecordRow, 12).Value = IIf(DimReview.Value, "Yes", "No")
            .Cells(RecordRow, 13).Value = IIf(WeldReview.Value, "Yes", "No")
            .Cells(RecordRow, 14).Value = IIf(Apperance.Value, "Yes", "No")
            .Cells(RecordRow, 15).Value = IIf(Complete.Value, "Yes", "No")
    End With
    msg = IIf(xlUpdate, "Updated", "Added")
    MsgBox "Record " & msg & " To Worksheet", 64, "Record " & msg




'Sub Clearform()
  Dim ctrl As msforms.Control
  For Each ctrl In Me.Controls
    Select Case TypeName(ctrl)
      Case "TextBox"
        ctrl.Text = ""
      Case "ComboBox"
        ctrl.ListIndex = -1
      Case "CheckBox"
        ctrl.Value = False
    End Select
  Next








End Sub




Private Sub Complete_Click()
Dim oCtrl As Control
    For Each oControl In Me.Controls
If TypeOf oControl Is msforms.CheckBox Then
oControl.Value = Complete.Value
End If
Next
End Sub


Private Sub OKButton_Click()
Dim EmptyRow As Long
'Make Sheet1 Active
    Sheet1.Activate


'Determine Empty Row
EmptyRow = WorksheetFunction.CountA(Range("A:A"))




'Transfer Information
Cells(EmptyRow, 1).Value = Customer.Value
Cells(EmptyRow, 2).Value = CSONumber.Value
Cells(EmptyRow, 3).Value = JobNumber.Value
Cells(EmptyRow, 4).Value = PCWeldType.Value
Cells(EmptyRow, 5).Value = PCWeldGrind.Value
Cells(EmptyRow, 6).Value = PCFinish.Value
Cells(EmptyRow, 7).Value = NonPCWeld.Value
Cells(EmptyRow, 8).Value = NonPCGrind.Value
Cells(EmptyRow, 9).Value = NonPCFinish.Value


If BRReview.Value = True Then Cells(EmptyRow, 10).Value = "Yes"
If BRReview.Value = False Then Cells(EmptyRow, 10).Value = "No"


If BOMReview.Value = True Then Cells(EmptyRow, 11).Value = "Yes"
If BOMReview.Value = False Then Cells(EmptyRow, 11).Value = "No"


If DimReview.Value = True Then Cells(EmptyRow, 12).Value = "Yes"
If DimReview.Value = False Then Cells(EmptyRow, 12).Value = "No"


If WeldReview.Value = True Then Cells(EmptyRow, 13).Value = "Yes"
If WeldReview.Value = False Then Cells(EmptyRow, 13).Value = "No"
  
If Apperance.Value = True Then Cells(EmptyRow, 14).Value = "Yes"
If Apperance.Value = False Then Cells(EmptyRow, 14).Value = "No"
 
If Complete.Value = True Then Cells(EmptyRow, 15).Value = "Yes"
If Complete.Value = False Then Cells(EmptyRow, 15).Value = "No"
MsgBox "Record Added"




'Sub Clearform()
  Dim ctrl As msforms.Control
  For Each ctrl In Me.Controls
    Select Case TypeName(ctrl)
      Case "TextBox"
        ctrl.Text = ""
      Case "ComboBox"
        ctrl.ListIndex = -1
      Case "CheckBox"
        ctrl.Value = False
    End Select
  Next


End Sub






Private Sub ClearForm()
  Dim ctrl As msforms.Control
  For Each ctrl In Me.Controls
    Select Case TypeName(ctrl)
      Case "TextBox"
        ctrl.Text = ""
      Case "ComboBox"
        ctrl.ListIndex = -1
      Case "CheckBox"
        ctrl.Value = False
    End Select
  Next
  End Sub
  
  
  Set Fnd = Nothing
  Me.CMDUpdate.Enabled = False
End Sub




Private Sub UserForm_Initialize()
    Set wsData = ThisWorkbook.Worksheets("Sheet1")
    Me.CMDUpdate.Enabled = False
End Sub

Thanks,

Bill Williamson
 
The code in the post and in the file is the same.
I would need to see the code you used to tell you what the problem was.
 
Upvote 0

Excel Facts

Which lookup functions find a value equal or greater than the lookup value?
MATCH uses -1 to find larger value (lookup table must be sorted ZA). XLOOKUP uses 1 to find values greater and does not need to be sorted.
Hello,

Next Button does not bring up MSG when reaching last Row.

https://www.dropbox.com/s/lybjwvd9adh7y4w/BOM Setup(Current) - Copy.xlsm?dl=0



Code:
Dim wsData As Worksheet
Dim Fnd As Range
Const xlUpdate As Integer = 2




Private Sub CancelButton_Click()
    Unload Me
End Sub






Private Sub CBNext_Click()
  Me.CBPrev.Enabled = True
  With wsData
    For i = Fnd.Row + 1 To .Range("A" & Rows.Count).End(xlUp).Row
      If .Range("A" & i).EntireRow.Hidden = False Then
        If .Range("A" & i).Value <> "" Then
          Set Fnd = Range("A" & i)
        Else
          MsgBox "Last row"
        End If
        Exit For
      End If
    Next
  End With
  Call FillControls
End Sub






Private Sub CBPrev_Click()
  With wsData
    For i = Fnd.Row - 1 To 1 Step -1
      If i = 1 Then
        MsgBox "Fisrt row"
        Me.CBPrev.Enabled = False
        Exit For
      End If
      If .Range("A" & i).EntireRow.Hidden = False Then
        If .Range("A" & i).Value <> "" Then
          Set Fnd = Range("A" & i)
        End If
        Exit For
      End If
    Next
  End With
  Call FillControls
End Sub






Private Sub CMDSearch_Click()
  Application.ScreenUpdating = False
      Dim i As Integer, n As Variant
        With wsData
         If .AutoFilterMode Then .AutoFilterMode = False
            If Customer.Value <> "" Then .Range("A1").AutoFilter 1, Me.Customer.Value
                If CSONumber.Value <> "" Then .Range("A1").AutoFilter 2, Me.CSONumber.Value
                    If JobNumber.Value <> "" Then .Range("A1").AutoFilter 3, Me.JobNumber.Value
                On Error Resume Next
            Set Fnd = .Range("A2:A" & Rows.Count).SpecialCells(xlVisible)(1)
        n = .Range("A1:A" & .Range("A" & Rows.Count).End(xlUp).Row).SpecialCells(xlCellTypeVisible).Count
    On Error GoTo 0
        If n < 2 Then
            MsgBox "Search term not found", 48, "Not Found"
            Me.CMDUpdate.Enabled = False
           Else
              Call FillControls
                Me.CMDUpdate.Enabled = True
            Me.CBNext.Enabled = True
        End If
  End With
  Application.ScreenUpdating = True
End Sub






Sub FillControls()
  For i = 1 To 15
    With Me.Controls(Choose(i, "Customer", "CSONumber", "JobNumber", "PCWeldType", "PCWeldGrind", _
                               "PCFinish", "NonPCWeld", "NonPCGrind", "NonPCFinish", "BRReview", _
                               "BOMReview", "DimReview", "WeldReview", "Apperance", "Complete"))
      If i < 10 Then
          .Text = Fnd.Offset(, i - 1).Value
      Else
          .Value = CBool(LCase(Fnd.Offset(, i - 1).Value) = "yes")
      End If
    End With
  Next i
End Sub






Private Sub ClearButton_Click()
    Call ClearForm
End Sub






Private Sub CMDUpdate_Click()
   AddUpdateRecord Fnd.Row, xlUpdate
End Sub






Sub AddUpdateRecord(ByVal RecordRow As Long, ByVal Action As Integer)
    Dim i As Integer
    Dim Answer As VbMsgBoxResult
    If Action = xlUpdate Then
'Update Records
        Answer = MsgBox("Are you sure you want to update?", vbYesNo + vbQuestion, "Update Record")
        If Answer = vbNo Then Exit Sub
    End If
With wsData
        For i = 1 To 9
            .Cells(RecordRow, i).Value = Choose(i, Customer.Value, CSONumber.Value, JobNumber.Value, _
                                                   PCWeldType.Value, PCWeldGrind.Value, PCFinish.Value, _
                                                   NonPCWeld.Value, NonPCGrind.Value, NonPCFinish.Value)
        Next i
    
            .Cells(RecordRow, 10).Value = IIf(BRReview.Value, "Yes", "No")
            .Cells(RecordRow, 11).Value = IIf(BOMReview.Value, "Yes", "No")
            .Cells(RecordRow, 12).Value = IIf(DimReview.Value, "Yes", "No")
            .Cells(RecordRow, 13).Value = IIf(WeldReview.Value, "Yes", "No")
            .Cells(RecordRow, 14).Value = IIf(Apperance.Value, "Yes", "No")
            .Cells(RecordRow, 15).Value = IIf(Complete.Value, "Yes", "No")
    End With
    msg = IIf(xlUpdate, "Updated", "Added")
    MsgBox "Record " & msg & " To Worksheet", 64, "Record " & msg
    
Call ClearForm


End Sub




Private Sub Complete_Click()
Dim oCtrl As Control
    For Each oControl In Me.Controls
If TypeOf oControl Is msforms.CheckBox Then
        oControl.Value = Complete.Value
End If
    Next
End Sub






Private Sub OKButton_Click()
Dim EmptyRow As Long
'Make Sheet1 Active
    Sheet1.Activate


'Determine Empty Row
EmptyRow = WorksheetFunction.CountA(Range("A:A"))


'Transfer Information
Cells(EmptyRow, 1).Value = Customer.Value
Cells(EmptyRow, 2).Value = CSONumber.Value
Cells(EmptyRow, 3).Value = JobNumber.Value
Cells(EmptyRow, 4).Value = PCWeldType.Value
Cells(EmptyRow, 5).Value = PCWeldGrind.Value
Cells(EmptyRow, 6).Value = PCFinish.Value
Cells(EmptyRow, 7).Value = NonPCWeld.Value
Cells(EmptyRow, 8).Value = NonPCGrind.Value
Cells(EmptyRow, 9).Value = NonPCFinish.Value


If BRReview.Value = True Then Cells(EmptyRow, 10).Value = "Yes"
If BRReview.Value = False Then Cells(EmptyRow, 10).Value = "No"


If BOMReview.Value = True Then Cells(EmptyRow, 11).Value = "Yes"
If BOMReview.Value = False Then Cells(EmptyRow, 11).Value = "No"


If DimReview.Value = True Then Cells(EmptyRow, 12).Value = "Yes"
If DimReview.Value = False Then Cells(EmptyRow, 12).Value = "No"


If WeldReview.Value = True Then Cells(EmptyRow, 13).Value = "Yes"
If WeldReview.Value = False Then Cells(EmptyRow, 13).Value = "No"
  
If Apperance.Value = True Then Cells(EmptyRow, 14).Value = "Yes"
If Apperance.Value = False Then Cells(EmptyRow, 14).Value = "No"
 
If Complete.Value = True Then Cells(EmptyRow, 15).Value = "Yes"
If Complete.Value = False Then Cells(EmptyRow, 15).Value = "No"


MsgBox "Record Added"


'Sub Clearform()
Call ClearForm


End Sub




Private Sub ClearForm()
  'AutoFilterMode = False
   Set Fnd = Nothing
  Me.CMDUpdate.Enabled = False
  Me.CBNext.Enabled = False
  Me.CBPrev.Enabled = False
  Dim ctrl As msforms.Control
  For Each ctrl In Me.Controls
    Select Case TypeName(ctrl)
      Case "TextBox"
        ctrl.Text = ""
      Case "ComboBox"
        ctrl.ListIndex = -1
      Case "CheckBox"
        ctrl.Value = False
    End Select
  Next
End Sub




Private Sub UserForm_Initialize()
    Set wsData = ThisWorkbook.Worksheets("Sheet1")
    Me.CMDUpdate.Enabled = False
    Customer.SetFocus
    Me.CBPrev.Enabled = False
    Me.CBNext.Enabled = False
End Sub


Thank you for any suggestions.

Bill Williamson
 
Upvote 0
Change CBNext_Click for this:

Code:
Private Sub [COLOR=#0000ff]CBNext_Click[/COLOR]()
  Dim lr As Long
  With wsData
    lr = .Range("A" & Rows.Count).End(xlUp).Row + 1
    For i = Fnd.Row + 1 To lr
      If i = lr Then
        MsgBox "Last row"
        Exit For
      End If
      If .Range("A" & i).EntireRow.Hidden = False Then
        If .Range("A" & i).Value <> "" Then
          Set Fnd = Range("A" & i)
        End If
        Exit For
      End If
    Next
  End With
  Call FillControls
End Sub
 
Upvote 0

Forum statistics

Threads
1,223,888
Messages
6,175,212
Members
452,618
Latest member
Tam84

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