Incorporating 'findnext' function into existing 'find' code?

Viewed 69

I've VBA code that is working and displaying the first match within a UserForm.

When calling the search, the user is presented a userform and focus is on a ComboBox which requires the user to select an option, and enter a search term in a TextBox (called TextBox1 for ease). They click 'Search' and the first match details are displayed in numerous other (disabled) TextBoxes within the form.

Private Sub btnDemProg_Click()
    Application.ScreenUpdating = False
    If ComboBox1.Value = "" Then
        MsgBox ("Please select a column.")
        ComboBox1.SetFocus
        Exit Sub
    End If
    If TextBox1.Value = "" Then
        MsgBox ("Please enter a search criterium.")
        TextBox1.SetFocus
        Exit Sub
    End If
    Dim sh As Worksheet, colFnd As Range, crit As Range
    Set sh = Sheets("DEMANDS")
    Set colFnd = sh.Rows(1).find(ComboBox1.Value, , xlValues, xlWhole)
    If Not colFnd Is Nothing Then
        Set crit = sh.Columns(colFnd.Column).find(TextBox1.Value, , xlValues, xlPart)
        If Not crit Is Nothing Then
            With sh
                Me.DmdNo.Value = .Cells(crit.Row, 1)
                Me.DmdDate.Value = .Cells(crit.Row, 2)
                Me.nsn.Value = .Cells(crit.Row, 3)
                Me.PTNum.Value = .Cells(crit.Row, 4)
                Me.desc.Value = .Cells(crit.Row, 5)
                Me.qty.Value = .Cells(crit.Row, 6)
                Me.DofQ.Value = .Cells(crit.Row, 7)
                Me.RDD.Value = .Cells(crit.Row, 8)
                Me.Sect.Value = .Cells(crit.Row, 18)
                Me.POC.Value = .Cells(crit.Row, 20)
                Me.ainu.Value = .Cells(crit.Row, 21)
                Me.inv.Value = .Cells(crit.Row, 22)
                Me.trilogy.Value = .Cells(crit.Row, 17)
                Me.ACtailNo.Value = .Cells(crit.Row, 16)
                Me.TechDoc.Value = .Cells(crit.Row, 28)
                Me.ACSys.Value = .Cells(crit.Row, 19)
                Me.ADF_LIM_Number.Value = .Cells(crit.Row, 25)
                Me.SNOW.Value = .Cells(crit.Row, 26)
                Me.reason.Value = .Cells(crit.Row, 27)
                Me.ProgText.Value = .Cells(crit.Row, 31)
            End With
        Else
            MsgBox "I cannot find this demand. Has it been cancelled/satisfied?"
        End If
    End If

How do I implement a 'find next' function within the existing code so that when a user clicks the search button a second (or third, or fourth etc.) time, it displays the next match of details within the userform, and if no additional matches are found, displays a MsgBox advising "No further matches found"?

I've seen and used the find next VBA function previously, but not in this context and not when I have a userform to fill with the new results.

1 Answers

Private Range Variable

  • Since you're exiting the procedure after each search, FindNext cannot help you.
  • Private crit As Range is used to store the current found cell (range) to be used as the After (2nd) parameter of the Find method for the next search (between subsequent calls of the procedure).
  • xlFormulas is allowing rows to be hidden.
  • Not tested.

The Code

Option Explicit

Private crit As Range

Private Sub btnDemProg_Click()
    Application.ScreenUpdating = False
    If ComboBox1.Value = "" Then
        MsgBox ("Please select a column.")
        ComboBox1.SetFocus
        Exit Sub
    End If
    If TextBox1.Value = "" Then
        MsgBox ("Please enter a search criterium.")
        TextBox1.SetFocus
        Exit Sub
    End If
    Dim sh As Worksheet, colFnd As Range, CheckRow As Long
    Set sh = Sheets("DEMANDS")
    Set colFnd = sh.Rows(1).Find(ComboBox1.Value, , xlFormulas, xlWhole)
    If Not colFnd Is Nothing Then
        With sh.Columns(colFnd.Column)
            If crit Is Nothing Then
                Set crit = .Find(TextBox1.Value, , xlFormulas, xlPart)
            Else
                If Intersect(.Offset, crit) Is Nothing Then
                    Set crit = .Find(TextBox1.Value, , xlFormulas, xlPart)
                Else
                    CheckRow = crit.Row
                    Set crit = .Find(TextBox1.Value, crit, xlFormulas, xlPart)
                End If
            End If
        End With
        If Not crit Is Nothing Then
            If crit.Row > CheckRow Then
                With sh
                    Me.DmdNo.Value = .Cells(crit.Row, 1)
                    Me.DmdDate.Value = .Cells(crit.Row, 2)
                    Me.nsn.Value = .Cells(crit.Row, 3)
                    Me.PTNum.Value = .Cells(crit.Row, 4)
                    Me.desc.Value = .Cells(crit.Row, 5)
                    Me.qty.Value = .Cells(crit.Row, 6)
                    Me.DofQ.Value = .Cells(crit.Row, 7)
                    Me.RDD.Value = .Cells(crit.Row, 8)
                    Me.Sect.Value = .Cells(crit.Row, 18)
                    Me.POC.Value = .Cells(crit.Row, 20)
                    Me.ainu.Value = .Cells(crit.Row, 21)
                    Me.inv.Value = .Cells(crit.Row, 22)
                    Me.trilogy.Value = .Cells(crit.Row, 17)
                    Me.ACtailNo.Value = .Cells(crit.Row, 16)
                    Me.TechDoc.Value = .Cells(crit.Row, 28)
                    Me.ACSys.Value = .Cells(crit.Row, 19)
                    Me.ADF_LIM_Number.Value = .Cells(crit.Row, 25)
                    Me.SNOW.Value = .Cells(crit.Row, 26)
                    Me.reason.Value = .Cells(crit.Row, 27)
                    Me.ProgText.Value = .Cells(crit.Row, 31)
                End With
            Else
                Set crit = Nothing
                MsgBox "No further matches found."
            End If
        Else
            MsgBox "I cannot find this demand. Has it been cancelled/satisfied?"
        End If
    End If
End Sub
Related