userform findrow if matching all multiple criteria?

[peterw1987]

https://drive.google.com/open?id=0B4xuRMTv-mCCc3ZnbFZwQWxUVTg

I have this userform(I named it payform) which I use to find/search data row, and then amend them. I copied and modified the code from other source.

But I just realize that the find button, find all the row if it match any of the 3 search criteria I set.
I want the find button to find the row if it match all of the 3 search criteria I set.

Private Sub buttSrch_Click()    Dim shCurrent As Worksheet
    Dim shResults As Worksheet
    Dim found As Range
    Dim firstFound As String
    Dim SrchCol_1 As String
    Dim SrchCol_2 As String
    Dim SrchCol_3 As String
    Dim r As String
    
    If tbSrch1 = "" And tbSrch2 = "" And tbSrch3 = "" Then Exit Sub
    
    Set shData = Sheets("Data") 'change to suit
    Set rgData = shData.Cells.CurrentRegion
    Set rgData = rgData.Offset(1, 0).Resize(rgData.Rows.Count - 1, rgData.Columns.Count)
    
    Set shCurrent = ActiveSheet
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    On Error Resume Next
    Sheets("Results").Delete
    On Error GoTo 0
    Application.DisplayAlerts = True
    Sheets.Add after:=Sheets(Sheets.Count)
    ActiveSheet.name = "Results"
    Set shResults = Sheets("Results")
    With shResults
        .Cells(1, 1) = "DataRow"
        
        .Cells(1, 5) = "HEADER1"
        .Cells(1, 8) = "HEADER2"
        .Cells(1, 13) = "HEADER3"
        .Cells(1, 19) = "HEADER4"
        .Cells(1, 22) = "HEADER5"
        .Cells(1, 23) = "HEADER6"
        .Cells(1, 24) = "HEADER7"
        .Cells(1, 25) = "HEADER8"
        .Cells(1, 26) = "HEADER9"
    End With
    
    'columns to search thru - change to suit
    SrchCol_1 = "A"
    SrchCol_2 = "D"
    SrchCol_3 = "G"
    
    lbResList.ListIndex = -1
    tbResCol1 = ""
    tbResCol2 = ""
    tbResCol3 = ""
    tbResCol4 = ""
    tbResCol5 = ""
    tbResCol6 = ""
    tbResCol7 = ""
    tbResCol8 = ""
    tbResCol9 = ""
    
    r = 1
    If tbSrch1 <> "" Then
        With rgData.Columns(SrchCol_1)
            Set found = .Find(tbSrch1, rgData.Cells(rgData.Rows.Count, SrchCol_1))
            If Not found Is Nothing Then
                firstFound = found.Address
                Do
                    r = r + 1
                    found.EntireRow.Copy shResults.Cells(r, 1)
                    shResults.Cells(r, 1).Insert Shift:=xlToRight
                    shResults.Cells(r, 1) = found.Row
                    Set found = .FindNext(found)
                Loop While Not found Is Nothing And found.Address <> firstFound
            End If
        End With
    End If
    If tbSrch2 <> "" Then
        With rgData.Columns(SrchCol_2)
            Set found = .Find(tbSrch2, rgData.Cells(rgData.Rows.Count, SrchCol_2))
            If Not found Is Nothing Then
                firstFound = found.Address
                Do
                    r = r + 1
                    found.EntireRow.Copy shResults.Cells(r, 1)
                    shResults.Cells(r, 1).Insert Shift:=xlToRight
                    shResults.Cells(r, 1) = found.Row
                    Set found = .FindNext(found)
                Loop While Not found Is Nothing And found.Address <> firstFound
            End If
        End With
    End If
    If tbSrch3 <> "" Then
        With rgData.Columns(SrchCol_3)
            Set found = .Find(tbSrch3, rgData.Cells(rgData.Rows.Count, SrchCol_3))
            If Not found Is Nothing Then
                firstFound = found.Address
                Do
                    r = r + 1
                    found.EntireRow.Copy shResults.Cells(r, 1)
                    shResults.Cells(r, 1).Insert Shift:=xlToRight
                    shResults.Cells(r, 1) = found.Row
                    Set found = .FindNext(found)
                Loop While Not found Is Nothing And found.Address <> firstFound
            End If
        End With
    End If
    If r = 1 Then
        lbResList.RowSource = ""
        MsgBox "No Results"
    Else
        Set rgResults = shResults.Cells.CurrentRegion
        Set rgResults = rgResults.Offset(1, 0).Resize(rgResults.Rows.Count - 1, 30)
        rgResults.RemoveDuplicates Columns:=Array(1), Header:=xlNo
        Set rgResults = shResults.Cells.CurrentRegion
        Set rgResults = rgResults.Offset(1, 0).Resize(rgResults.Rows.Count - 1, 30)
        ActiveWorkbook.Names.Add name:="rgResults", RefersTo:=rgResults
        lbResList.RowSource = "rgResults"
    End If
    
    shCurrent.Activate
    Application.ScreenUpdating = True
End Sub

example: I want to find 1 A x row

1 A x
2 B y
1 B x


What the form is doing now is, it will show row 1(because it match 3 criteria) and row 3( because it match 2 criteria)
What I want is , it will only display the row 1.

Really need someone to teach me what to edit. Thanks before.

 

[portews]

I didn't spend a lot of time investigating what you have. See if I'm reading this code correctly. Right now, you are searching for a match in the first search column and returning all that you find. Then you are doing a search in your second search column, then the 3rd, as show by the 3 sections beginning with "If tbSrch..."

It wasn't immediately intuitive where you're getting tbSrch1, 2 and 3 from. Are you always searching the same columns for your first, second and 3rd criteria? If so, it should be easy to say "once I've matched the first column, see if the 3rd column over matches tbSrch2 and the 6the column over matches tbSrch3.

What I would do is get rid of the second and 3rd searches. Once you find a match in the search for the first term, check for a match in the second and third terms. something like this:

If tbSrch1 <> "" Then
        With rgData.Columns(SrchCol_1)
            Set found = .Find(tbSrch1, rgData.Cells(rgData.Rows.Count, SrchCol_1))
            If Not found Is Nothing Then                                     [COLOR=#00ff00]'once you've found the first match...[/COLOR]
                firstFound = found.Address
                Do
                    r = r + 1
[COLOR=#ff0000]                    If found.offset(0, #columns#)= tbSrch2 then       [/COLOR][COLOR=#00ff00]'if however many columns over matches your 2nd search criteria...[/COLOR]
[COLOR=#ff0000]                         If found.offset(0, #columns#)= tbSrch3 then  [/COLOR][COLOR=#00ff00]'if however many columns over matches your 3rd search criteria...[/COLOR]
                            found.EntireRow.Copy shResults.Cells(r, 1)   [COLOR=#00ff00]'then do the copy, insert and paste like you did before.[/COLOR]
                            shResults.Cells(r, 1).Insert Shift:=xlToRight
                            shResults.Cells(r, 1) = found.Row
[COLOR=#ff0000]                         end if[/COLOR]
[COLOR=#ff0000]                    end if[/COLOR]
                    Set found = .FindNext(found)
                Loop While Not found Is Nothing And found.Address <> firstFound
            End If
        End With
    End If

Note that I've not tried this and the red is not be the actual code needed, but it should be close. Replace the #column# with the actual column offsets.

Let me know if this helps.