Find all

[kevski]

Hi guys,

Please can you help? I need to change the code below to allow me to search any of the fields in my Form or a combination of fields instead of just Job Card. Also, I can only use 9 columns in the ListCount and I need to return 17 columns.

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("a8", Range("a65536").End(xlUp))
    Dim f      As Integer

    imgFolder = ThisWorkbook.Path & Application.PathSeparator & "images" & Application.PathSeparator
    strFind = Me.TEXTJOBCARD.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
                .TEXTCUSTOMER.Value = c.Offset(0, 1).Value
                .TEXTPROGRAM.Value = c.Offset(0, 2).Value
                .COMBOTHICKNESS.Value = c.Offset(0, 3).Value
                .COMBOGRADE.Value = c.Offset(0, 4).Value
             '   .COMBOMACHINE.Value = c.Offset(0, 5).Value
             '   .TEXTLENGTH.Value = c.Offset(0, 6).Value
            '    .TXTPIERCE = c.Offset(0, 7).Value
            '    .TEXTSHEETS.Value = c.Offset(0, 8).Value
                .TEXTCOMPLETE.Value = c.Offset(0, 9).Value
              '  .TEXTSTOCK.Value = c.Offset(0, 10).Value
              '  .TEXTDUEDATE.Value = c.Offset(0, 11).Value
             '   .COMBOCOMORARM.Value = c.Offset(0, 12).Value
                .TEXTCASTNUMBER.Value = c.Offset(0, 13).Value
                .TEXTDATEENTERD.Value = c.Offset(0, 14).Value
                .TEXTTIMETAKEN = c.Offset(0, 15).Value
                .TEXTFEEDRATEUSED.Value = c.Offset(0, 16).Value
                
                .cmbAmend.Enabled = True     'allow amendment or
          '      .cmbDelete.Enabled = True    'allow record deletion
           '     .cmbAdd.Enabled = False      'don't want to duplicate record
                
            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




Sub FindAll()
    Dim strFind As String    'what to find
    Dim rFilter As Range     'range to search
    Set rFilter = Sheet1.Range("a8", Range("E65536").End(xlUp))
    Set rng = Sheet1.Range("a8", Range("E65536").End(xlUp))
    strFind = Me.TEXTJOBCARD.Value
    strFind = Me.TEXTCUSTOMER.Value
    With Sheet1
        If Not .AutoFilterMode Then .Range("A8 & B8").AutoFilter
        rFilter.AutoFilter field:=1, Criteria1:=strFind
        Set rng = rng.Cells.SpecialCells(xlCellTypeVisible)
        Me.LISTBOX2.Clear
        For Each c In rng
            With Me.LISTBOX2
                 .AddItem c.Value
                .List(.ListCount - 1, 1) = c.Offset(0, 1).Value
                .List(.ListCount - 1, 2) = c.Offset(0, 2).Value
                .List(.ListCount - 1, 3) = c.Offset(0, 3).Value
                .List(.ListCount - 1, 4) = c.Offset(0, 4).Value
                .List(.ListCount - 1, 5) = c.Offset(0, 9).Value
                .List(.ListCount - 1, 6) = c.Offset(0, 13).Value
                .List(.ListCount - 1, 7) = c.Offset(0, 14).Value
                .List(.ListCount - 1, 8) = c.Offset(0, 15).Value
                .List(.ListCount - 1, 9) = c.Offset(0, 16).Value
                
            End With
        Next c
    End With
End Sub