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
sample1.xls : https://app.box.com/s/xh58fgjl74w06hvsd53jriqkohdm6a3q
sample2.xlsx : https://app.box.com/s/np7kbvjydnyiu95pzyrgn76qi1uqg0ma
vba.xlsm : https://app.box.com/s/lf6otsrl42m6vxxvycjo04zidya6pd2m




Reply With Quote
Bookmarks