I am using a match formula inside of a for loop, but it is taking too much time. Is there any way to optimize this code to make it go faster?

 Lastrow = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row
For i = 3 To Lastrow

       Sheets("sample").Range("AM1000000").End(xlUp).Offset(1, 0).Select
        Selection.FormulaArray = _
        "=IF(ISNUMBER(MATCH(1," & Chr(10) & "  (order!R2C15:R1000000C15=RC[-24])*" & Chr(10) & "  (order!R2C7:R1000000C7=RC[-32])*" & Chr(10) & "  (order!R2C24:R1000000C24=RC[-15])," & Chr(10) & "  0)), ""pass"",""review"")"

    Next i
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
  • \$\begingroup\$ What is the end result you're trying to achieve? I suspect there is a much easier way to accomplish a solution \$\endgroup\$
    – PeterT
    May 17 '17 at 13:23

The key optimisation can be found in this part:

Dim orderColumnOArray as Variant, orderColumnGArray as Variant, orderColumnXArray as Variant
orderColumnOArray = ThisWorkbook.Worksheets("order").Range("O2:O1000000").Value
orderColumnGArray = ThisWorkbook.Worksheets("order").Range("G2:G1000000").Value
orderColumnXArray = ThisWorkbook.Worksheets("order").Range("X2:X1000000").Value

There above, we are using arrays to store the order data, and we can traverse them more efficiently, rather than repeat a full array formula calculation for each cell.

Note that even then we could cut down on the million rows, and do a lastRow calculation for the order sheet. Perhaps that will bring great improvement too. However if we say for now that you will genuinely have that number of data rows in the order Worksheet, we can still go about it a bit better.

With ThisWorkbook.WorkSheets("sample")
    'I will assume that the column needs to filled from AM3 to AMLastrow
    'I also assume the tested values are strings or integers, not dates or floats
    Dim resultArray() as String
    ReDim resultArray(3 to Lastrow)
    Dim j as Long

    For i = 3 To Lastrow
        resultArray(i) = "review"
        For j = 1 To Ubound(orderColumnOArray)
            'The below nested Ifs can be done in many different ways
            'e.g. And with the 3 equality tests
            'or even by initially making two concatenated arrays!
            If .Range("O" & i).Value = orderColumnOArray(j, 1) Then
                If .Range("G" & i).Value = orderColumnGArray(j, 1) Then
                    If .Range("X" & i).Value = orderColumnXArray(j, 1) Then
                        resultArray(i) = "pass"
                        Exit For
                    End if
                End if
            End if
        Next j
    Next i

    'Now we can write back the array to the worksheet faster
    .Range("AM3").Resize(Lastrow - 3 + 1, 1).Value = resultArray
End With

May want to read the cells into an array, process within the VBA world, then write out cells to the sheet. Going back and forth to the worksheets typically slow.


Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.