Using Match function to copy rows with more than 1 criteria and incrementation

Question

I had been trying to do matching of 2 criteria in a row on one worksheet and copy the whole row to another worksheet in the same workbook. As the loop goes on, the criteria will also increase like 1, 2 ,3 or 1A, 2A, 3A, etc. How do I use the match function so that when it is matched, it copy the whole row.

Find 1st criteria, if matched, find next criteria. 2nd, 3rd criteria is in different colum but same row.
If 2nd criteria does not matched, look for next row with matched 1st criteria in different row
If both criteria matched, whole row is copy and paste to another worksheet
Criteria increased and match function start to find new matched criteria

I had been trying on this code but doesn't seem to work or give a lot error, instead of using INDEX, I change it to CopyEntireRow.

=INDEX($D$2:$D$10,MATCH(1,(A13=$B$2:$B$10)*(B13=$C$2:$C$10),0))

I need some helps or advice for a better way to improve this method. Thanks!

1 criteria code

Private Sub CommandButton1_Click()
Dim strLastRow As String
Dim rngC As Range
Dim strToFind As String, FirstAddress As String
Dim wSht As Worksheet
Dim rngtest As String
Application.ScreenUpdating = False

Set wSht = Worksheets("Data")
With wSht.Range("BM1:BM5000")
Set rngC = .Find(What:="PVC/", lookat:=xlPart)
If Not rngC Is Nothing Then
FirstAddress = rngC.Address
 Do
   strLastRow = Sheets("Cable List").Range("BJ" & Rows.Count).End(xlUp).Row + 1
   rngC.EntireRow.Copy
   Sheets("Cable List").Cells(strLastRow, 1).PasteSpecial xlPasteValues
   Application.CutCopyMode = False
   Set rngC = .FindNext(rngC)
 Loop While Not rngC Is Nothing And rngC.Address <> FirstAddress
End If
End With

The code above find "PVC/" string in one worksheet "Data" and all matched row with the string inside will be copy to "Cable_List" worsksheet.

Are you mixing vba and Excel formulas? You can copy a row using vba, but the formula you posted here doesn't work in vba. Also, what is CopyEntrireRow? Is it a sub/function you wrote? — yu_ominae
@yu_ominae Yes, it's a function, I am writing all this code using excel vba from microsoft excel developer tab itself, CopyEntireRow*, my bad its a typo. — Wilson Teng
In that case you are going wrong with the function. As far as I know a UDF can only return values, but can not modify the state of the sheet. If you want to do this, you will have to write a macro or do it with formulas only. Note that you can actually do this with formulas only, which is usually better than using vba. — yu_ominae
@yu_ominae oh, but before that I had done a vba with 1 criteria and it works perfectly, when it comes to 2 criteria, i had no idea. I will update the 1 criteria code. — Wilson Teng
Oh, Sorry, my bad then I must have misunderstood the way functions work. Then that can only mean that your criteria is not correct. Have you stepped through the match formula to see if you are actually picking up the values correctly? — yu_ominae

Tim Williams Tim Williams · Accepted Answer · 2014-08-04T04:55:43

Maybe something like this (untested)

Private Sub CommandButton1_Click()
Dim LastRow As Long, lb As Long
Dim rngC As Range
Dim arrToFind, colToSearch, FirstAddress As String
Dim wSht As Worksheet, shtList As Worksheet, rw As Range
Dim rngtest As String, i As Long
Dim hit As Boolean

    Application.ScreenUpdating = False

    'array of words to search for
    arrToFind = Array("PVC/", "Test1", "Test2")

    'array of which column to look in for each word
    colToSearch = Array(65, 66, 67)

    lb = LBound(arrToFind) 'never count on lbound being zero...

    Set wSht = Worksheets("Data")
    Set shtList = Sheets("Cable List")

    LastRow = shtList.Range("BJ" & Rows.Count).End(xlUp).Row + 1

    With wSht.Cells(1, colToSearch(lb)).Resize(5000, 1)

        Set rngC = .Find(What:=arrToFind(lb), lookat:=xlPart)

        If Not rngC Is Nothing Then
            FirstAddress = rngC.Address
            Do
                hit = True
                Set rw = rngC.EntireRow

                For i = (lb + 1) To UBound(arrToFind)
                    If rw.Cells(colToSearch(i)).Value <> arrToFind(i) Then
                        hit = False
                        Exit For
                    End If
                Next i

                If hit = True Then
                    shtList.Rows(LastRow).Value = rw.Value
                    LastRow = LastRow + 1
                End If

                Set rngC = .FindNext(rngC)
             Loop While Not rngC Is Nothing And rngC.Address <> FirstAddress
        End If
    End With

End Sub

Using Match function to copy rows with more than 1 criteria and incrementation

1 Answers