Alternative solution to Step6()
( https://excelfox.com/forum/showthrea...ll=1#post14594 )



The main changes are
_1) I use arrays. ( arr1() , arr2() , arr2B() )
I do this just from personal choice. I do this because arrays work much faster if you are only interested in values with no cell formatting
_2) I changed WorksheetFunction.Match to Application.Match , because I do not like to use On Error Resume Next
I do not need On Error Resume Next for Application.Match , because , if it does not find a match, it does not error. Instead, it returns a VBA error string message, which can be tested for using IsError( __ )
_2) I do not use _ With _ End With _ because it confuses me

I left the original code lines in , ' commented out for comparison



Code:
' https://www.excelforum.com/excel-programming-vba-macros/1318061-conditionally-calculate-the-data-and-paste-it-if-condition-matches.html#post5342720    https://www.excelforum.com/excel-programming-vba-macros/1318061-conditionally-calculate-the-data-and-paste-it-if-condition-matches.html#post5342598
'     https://excelfox.com/forum/showthread.php/2349-Copy-and-Paste-based-on-comparisons-Match-and-calculations-of-cells-in-two-workbooks/page4#post14578  https://excelfox.com/forum/showthread.php/2349-Copy-and-Paste-based-on-comparisons-Match-and-calculations-of-cells-in-two-workbooks?p=14578&viewfull=1#post14578
'  https://excelfox.com/forum/showthread.php/2349-Copy-and-Paste-based-on-comparisons-Match-and-calculations-of-cells-in-two-workbooks?p=14591&viewfull=1#post14591
Sub STEP6Alternative()
Rem 1 Worksheets data info
Dim Wb1 As Workbook, Wb2 As Workbook, Ws1 As Worksheet, Ws2 As Worksheet
Dim I As Long, Lr As Long   '       R2 As Long, Lr As Long, I As Long ' r2&, lr&, i&
Set Wb1 = Workbooks("1.xls") ' For open workbook              Alternatively to open workbook - Examples: Workbooks.Open(ThisWorkbook.Path & "\1.xls") '  Workbooks.Open("C:\Users\WolfieeeStyle\Desktop\1.xls")
Set Ws1 = Wb1.Worksheets.Item(1)
Set Wb2 = Workbooks("AlertCodes.xlsx")                                                                 ' Workbooks.Open(ThisWorkbook.Path & "\AlertCodes.xlsx") ' Workbooks.Open("C:\Users\WolfieeeStyle\Desktop\Files\AlertCodes.xlsx")
Set Ws2 = Wb2.Worksheets.Item(4)
'    With Ws1
 Let Lr = Ws1.Cells(Ws1.Rows.Count, "A").End(xlUp).Row
Dim arr1() As Variant
Let arr1() = Ws1.Range("A1:K" & Lr & "").Value2
Dim lr2 As Long '    https://excelfox.com/forum/showthread.php/2364-Delete-rows-based-on-match-criteria-in-two-excel-files?p=14565&viewfull=1#post14565   Make Lr Dynamic : https://excelfox.com/forum/showthread.php/2364-Delete-rows-based-on-match-criteria-in-two-excel-files?p=11467&viewfull=1#post11467
 Let lr2 = Ws2.Cells(Ws2.Rows.Count, "B").End(xlUp).Row          ' This is the column to be serached in
Dim arr2B() As Variant
 Let arr2B() = Ws2.Range("B1:B" & lr2 & "").Value2
Dim arr2() As Variant
 Let arr2() = Ws2.Range("A1:K" & lr2 & "").Value2
Rem We consider the data values in column I of 1.xls ( first worksheet) , starting from row 2.
    For I = 2 To Lr ' We consider the data values in column I of 1.xls ( first worksheet) , starting from row 2.
                                                                 ' Reset r2 R2 = 0   ' Avoid error messages  On Error Resume Next
    ' Try to get r2       Values in column I of 1.xls ( first worksheet), starting at row 2, are to be looked for, ( Matched ) in column B of AlertCodes.xlsx ( 4th worksheet )
    'R2 = WorksheetFunction.Match(.Cells(I, "I"), Ws2.[B:B], 0)  '  R2 returns the  matched row  if there is a match
    Dim R2 As Variant  ' We need a variant so that  both a  Long Number   or a  VB error  can be held in it, which are the two possible return types with Application.Match  https://excelfox.com/forum/showthread.php/2349-Copy-and-Paste-based-on-comparisons-Match-and-calculations-of-cells-in-two-workbooks?p=14204&viewfull=1#post14204
     Let R2 = Application.Match(arr1(I, 9), arr2B(), 0)    ' Ws1.Cells(I, "I").Value  is  arr1(I, 9)                                                          ' Restore error handling     On Error GoTo 0
    ' Only set column K if r2 is valid, so only if a match was found, so only if R" is  Not  a  VBA error
        If Not IsError(R2) Then '                    If R2 > 0 Then
            'If Ws2.Cells(R2, "D") = ">" Then   '    Ws2.Cells(R2, "D").Value  is  arr2(R2, 4)
            If arr2(R2, 4) = ">" Then
            ' Ws1.Cells(I, "K").Value = Ws2.Cells(R2, "E").Value - 0.01 * Ws2.Cells(R2, "E").Value   '                                     This was wrong:  Ws2.Cells(I, "E").Value - 0.01 * Ws2.Cells(I, "E").Value
                          arr1(I, 11) = arr2(R2, 5) - 0.01 * arr2(R2, 5)
            'Else
            ElseIf arr2(R2, 4) = "<" Then
            ' Ws1.Cells(I, "K").Value = Ws2.Cells(R2, "E").Value + 0.01 * Ws2.Cells(R2, "E").Value   '                                     This was wrong:  Ws2.Cells(I, "E").Value + 0.01 * Ws2.Cells(I, "E").Value
                          arr1(I, 11) = arr2(R2, 5) + 0.01 * arr2(R2, 5)
            Else
             ' we dont have a "<" or a ">"  Do Nothing
            End If
       End If
    Next I
'   End With
'Rem Option to save and/ or close files
Wb1.Save
Wb1.Close
Wb2.Close
End Sub