Appendix-Thread-Evaluate-Range-(-Codes-for-other-Threads-HTML-Tables-etc-)

**DocAElstein** · 05-26-2020, 02:16 PM

Macro for this post
https://excelfox.com/forum/showthrea...-condition-met

Code:

Sub VBAAppendDataToExcelFileRowBasedOnTwoExcelFileConditions2()  '           https://excelfox.com/forum/showthread.php/2517-Copy-and-paste-the-data-if-condition-met   Previous macro where second file is  .csv  text file                https://excelfox.com/forum/showthread.php/2505-copy-paste-the-data-if-condition-matches?p=13616&viewfull=1#post13616
Rem 1 sample1.xls
Dim Wb1 As Workbook, Ws1 As Worksheet
' Set Wb = Workbooks.Open(ThisWorkbook.Path & "\" & "Sample1.xls")
' Set Wb = Workbooks.Open(ThisWorkbook.Path & Application.PathSeparator & "Sample1.xls")
 Set Wb1 = Workbooks("Sample1.xls")
 Set Ws1 = Wb1.Worksheets.Item(1)
Dim arrWs1() As Variant: Let arrWs1() = Ws1.Range("A1").CurrentRegion.Value2
Dim Lr1 As Long: Let Lr1 = UBound(arrWs1(), 1)
Rem 2 sample2.xlsx
Dim Wb2 As Workbook, Ws2 As Worksheet
 Set Wb2 = Workbooks("Sample2.xlsx")
 Set Ws2 = Wb2.Worksheets.Item(1)
Dim RwCnt2 As Long: Let RwCnt2 = Ws2.Range("A" & Ws2.Rows.Count & "").End(xlUp).Row
Dim NxtRw As Long: Let NxtRw = RwCnt2 + 1 ' next free row in sample2.xlsx
' 2d) second column in sample2.xlsx up maximum size of  sample1.xls   - that will be the biggest size needed
Dim Clm2() As Variant: Let Clm2() = Ws2.Range("B1:B" & Lr1 & "").Value  '  Clm2Sample2xlsx.JPG

Rem 3 Do it
Dim Cnt As Long
    For Cnt = 2 To Lr1 ' considering each data row in  Sample1.xls
    ' ( If column K of sample1.xls is greater than Column D of sample1.xls & Column H of sample1.xls is Greater than column K of sample1.xls ) or ( If column K of sample1.xls is lower than Column D of sample1.xls & Column H of sample1.xls is lower than column K of sample1.xls ) Then
    '                          Condition 1)                                    or         Condition 2)
        If (arrWs1(Cnt, 11) > arrWs1(Cnt, 4) And arrWs1(Cnt, 8) > arrWs1(Cnt, 11)) Or (arrWs1(Cnt, 11) < arrWs1(Cnt, 4) And arrWs1(Cnt, 8) < arrWs1(Cnt, 11)) Then
        Dim MtchRes As Variant ' for match column I of of Sample1.xls with second data column of   Sample2.xls Clm2()
         Let MtchRes = Application.Match(arrWs1(Cnt, 9), Clm2(), 0) ' match column I of of 1.xls with second column data of sample2.xlsx
        ' Match Column I of sample1.xls with second column (column B) of sample2.xlsx
            If Not IsError(MtchRes) Then  ' if it is there then do nothing
            '  match obtsained do nothing
            Else '   it is not present   paste the column I data of sample1.xls to second column values (column B) of sample2.xlsx
             Let Clm2(NxtRw, 1) = arrWs1(Cnt, 9)
                If NxtRw <> Lr1 Then Let NxtRw = NxtRw + 1 ' If we are not already at the maximum possible row in column B, Ws2 , then we need to adjust  NxtRw  for next possible missing match
            End If

        Else
        ' Neither of the 2 conditions are met so do nothing
        End If
    
    Next Cnt

Rem Paste out adjusted/ added to  Ws2 column B
 Ws2.Range("B1:B" & Lr1 & "").Value = Clm2()
End Sub