assfhshffhsfskfh
assfhshffhsfskfh
In support of answer for this post.
https://excelfox.com/forum/showthrea...3470#post13470
Text file supplied Sample2.csv ( Avinash : https://excelfox.com/forum/showthrea...ll=1#post13470
sample2 ef 5 June.csv : https://app.box.com/s/0j4118cwzzofe76ytb5rqkvz3qj0vseu
sample2.csv : https://app.box.com/s/0ej2h41g9fvm94cflf2j60a8o6p3334t )
Open in/ with Excel: ( Like: this: https://imgur.com/7pAaLVx , https://excelfox.com/forum/showthrea...ll=1#post13440 , for example with text editorCode:NSE,101010,6,<,12783,A,,,,,GTT,,,,,,,,,,,,, NSE,22,6,<,12783,A,,,,,GTT,,,,,,,,,,,,, NSE,17388,6,<,12783,A,,,,,GTT,,,,,,,,,,,,, ,100,,,,,,,,,,,,,,,,,,,,,, ,25,,,,,,,,,,,,,,,,,,,,,, ,,,,,,,,,,,,,,,,,,,,,,, ,,,,,,,,,,,,,,,,,,,,,,, ,,,,,,,,,,,,,,,,,,,,,,, ,,,,,,,,,,,,,,,,,,,,,,, ,,,,,,,,,,,,,,,,,,,,,,, ,,,,,,,,,,,,,,,,,,,,,,, ,,,,,,,,,,,,,,,,,,,,,,, ,,,,,,,,,,,,,,,,,,,,,,, ,,,,,,,,,,,,,,,,,,,,,,, ,,,,,,,,,,,,,,,,,,,,,,, ,,,,,,,,,,,,,Only for understanding purpose,,,,,,,,,, ,,,,,,,,,,,,,,,,,,,,,,, ,,,,,,,,,,,,,Before runing the macro,,,,,,,,,, ,,,,,,,,,,,,,,,,,,,,,,, ,,,,,,,,,,,,,NSE,101010,6,<,12783,A,,,,,GTT ,,,,,,,,,,,,,NSE,22,6,<,12783,A,,,,,GTT ,,,,,,,,,,,,,NSE,17388,6,<,12783,A,,,,,GTT ,,,,,,,,,,,,,,,,,,,,,,, ,,,,,,,,,,,,,,,,,,,,,,, ,,,,,,,,,,,,,,,,,,,,,,, ,,,,,,,,,,,,,,,,,,,,,,, ,,,,,,,,,,,,,After runing the macro,,,,,,,,,, ,,,,,,,,,,,,,,,,,,,,,,, ,,,,,,,,,,,,,,,,,,,,,,, ,,,,,,,,,,,,,,,,,,,,,,, ,,,,,,,,,,,,,NSE,101010,6,<,12783,A,,,,,GTT ,,,,,,,,,,,,,NSE,22,6,<,12783,A,,,,,GTT ,,,,,,,,,,,,,NSE,17388,6,<,12783,A,,,,,GTT ,,,,,,,,,,,,,,100,,,,,,,,, ,,,,,,,,,,,,,,25,,,,,,,,,
OpenSample2_csvManually with Excel.JPG : https://imgur.com/e7CxxpV)
Attachment 2963
_____ Workbook: sample2.csv ( Using Excel 2007 32 bit )
Worksheet: sample2
Row\Col NSE,101010,6,<,12783,A,,,,,GTT,,,,,,,,,,,,, NSE,22,6,<,12783,A,,,,,GTT,,,,,,,,,,,,, NSE,17388,6,<,12783,A,,,,,GTT,,,,,,,,,,,,, ,100,,,,,,,,,,,,,,,,,,,,,, ,25,,,,,,,,,,,,,,,,,,,,,, ,,,,,,,,,,,,,,,,,,,,,,, ,,,,,,,,,,,,,,,,,,,,,,, ,,,,,,,,,,,,,,,,,,,,,,, ,,,,,,,,,,,,,,,,,,,,,,, ,,,,,,,,,,,,,,,,,,,,,,, ,,,,,,,,,,,,,,,,,,,,,,, ,,,,,,,,,,,,,,,,,,,,,,, ,,,,,,,,,,,,,,,,,,,,,,, ,,,,,,,,,,,,,,,,,,,,,,, ,,,,,,,,,,,,,,,,,,,,,,, ,,,,,,,,,,,,,Only for understanding purpose,,,,,,,,,, ,,,,,,,,,,,,,,,,,,,,,,, ,,,,,,,,,,,,,Before runing the macro,,,,,,,,,, ,,,,,,,,,,,,,,,,,,,,,,, ,,,,,,,,,,,,,NSE,101010,6,<,12783,A,,,,,GTT ,,,,,,,,,,,,,NSE,22,6,<,12783,A,,,,,GTT ,,,,,,,,,,,,,NSE,17388,6,<,12783,A,,,,,GTT ,,,,,,,,,,,,,,,,,,,,,,, ,,,,,,,,,,,,,,,,,,,,,,, ,,,,,,,,,,,,,,,,,,,,,,, ,,,,,,,,,,,,,,,,,,,,,,, ,,,,,,,,,,,,,After runing the macro,,,,,,,,,, ,,,,,,,,,,,,,,,,,,,,,,, ,,,,,,,,,,,,,,,,,,,,,,, ,,,,,,,,,,,,,,,,,,,,,,, ,,,,,,,,,,,,,NSE,101010,6,<,12783,A,,,,,GTT ,,,,,,,,,,,,,NSE,22,6,<,12783,A,,,,,GTT ,,,,,,,,,,,,,NSE,17388,6,<,12783,A,,,,,GTT ,,,,,,,,,,,,,,100,,,,,,,,, ,,,,,,,,,,,,,,25,,,,,,,,,
Open with Excel VBA:
see next post : https://excelfox.com/forum/showthrea...ll=1#post13476Code:Sub OpenVBASample2_csv_5June() ' https://excelfox.com/forum/showthread.php/2345-Appendix-Thread-(-Codes-for-other-Threads-HTML-Tables-etc-)?p=13476&viewfull=1#post13476 ' Workbooks.Open Filename:=ThisWorkbook.Path & "\" & "Sample2.csv" Workbooks.Open Filename:=ThisWorkbook.Path & Application.PathSeparator & "Sample2.csv" ' CHANGE TO SUIT End Sub ' see next post : https://excelfox.com/forum/showthread.php/2345-Appendix-Thread-(-Codes-for-other-Threads-HTML-Tables-etc-)?p=13476&viewfull=1#post13476
_____ Workbook: sample2.csv ( Using Excel 2007 32 bit )Code:Sub OpenVBASample2_csv_5June() ' ' Workbooks.Open Filename:=ThisWorkbook.Path & "\" & "Sample2.csv" Workbooks.Open Filename:=ThisWorkbook.Path & Application.PathSeparator & "Sample2.csv" ' CHANGE TO SUIT End Sub
Worksheet: sample2
Row\Col NSE < A GTT NSE < A GTT NSE < A GTT Only for understanding purpose Before runing the macro NSE < A GTT NSE < A GTT NSE < A GTT After runing the macro NSE < A GTT NSE < A GTT NSE < A GTT
Note : Sometimes Excel manually or Excel VBA will open .csv file and put values across column cells. but also sometimes Excel manually or Excel VBA will open .csv file and put all values and commas in first cell
Sample2After.csv
Code:NSE,101010,6,<,12783,A,,,,,GTT NSE,22,6,<,12783,A,,,,,GTT NSE,17388,6,<,12783,A,,,,,GTT ,100,,,,,,,,,, ,25,,,,,,,,,,
In Excel ( open manually )
Open Sample2_csv Manually with Excel.JPG : https://imgur.com/9QNhxrA
_____ Workbook: Sample2After.csv ( Using Excel 2007 32 bit )
Worksheet: Sample2After
Row\Col NSE,101010,6,<,12783,A,,,,,GTT NSE,22,6,<,12783,A,,,,,GTT NSE,17388,6,<,12783,A,,,,,GTT ,100,,,,,,,,,, ,25,,,,,,,,,,
In Excel VBA
_____ Workbook: Sample2After.csv ( Using Excel 2007 32 bit )Code:_ Workbooks.Open Filename:=ThisWorkbook.Path & Application.PathSeparator & "Sample2After.csv" ' CHANGE TO SUIT
Worksheet: Sample2After
Row\Col NSE < A GTT NSE < A GTT NSE < A GTT
Note : Sometimes Excel manually or Excel VBA will open .csv file and put values across column cells. but also sometimes Excel manually or Excel VBA will open .csv file and put all values and commas in first cell
Code:Call WtchaGot_Unic_NotMuchIfYaChoppedItOff(TotalFileToRwCnt)Code:"NSE" & Chr(44) & "101010" & Chr(44) & "6" & Chr(44) & Chr(60) & Chr(44) & "12783" & Chr(44) & "A" & Chr(44) & Chr(44) & Chr(44) & Chr(44) & Chr(44) & "GTT" & vbCr & vbLf & "NSE" & Chr(44) & "22" & Chr(44) & "6" & Chr(44) & Chr(60) & Chr(44) & "12783" & Chr(44) & "A" & Chr(44) & Chr(44) & Chr(44) & Chr(44) & Chr(44) & "GTT" & vbCr & vbLf & "NSE" & Chr(44) & "17388" & Chr(44) & "6" & Chr(44) & Chr(60) & Chr(44) & "12783" & Chr(44) & "A" & Chr(44) & Chr(44) & Chr(44) & Chr(44) & Chr(44) & "GTT" & vbCr & vbLf & Chr(44) & "100" & Chr(44) & Chr(44) & Chr(44) & Chr(44) & Chr(44) & Chr(44) & Chr(44) & Chr(44) & Chr(44) & Chr(44) & vbCr & vbLf & Chr(44) & "25" & Chr(44) & Chr(44) & Chr(44) & Chr(44) & Chr(44) & Chr(44) & Chr(44) & Chr(44) & Chr(44) & Chr(44) & vbCr & vbLf
Macro for this post:
https://excelfox.com/forum/showthrea...ll=1#post13470
Code:' https://excelfox.com/forum/showthread.php/2505-copy-paste-the-data-if-condition-matches?p=13470#post13470 Sub VBAAppendDataToTextFileLineBasedOnTheTextFileAndExcelFileConditions() Rem 1 Workbook, Worksheet info ( Excel File ) Dim Wb As Workbook, Ws As Worksheet ' Set Wb = Workbooks.Open(ThisWorkbook.Path & "\" & "Sample1.xls") ' Set Wb = Workbooks.Open(ThisWorkbook.Path & Application.PathSeparator & "Sample1.xls") Set Wb = Workbooks("1.xls") ' Workbooks("Sample1.xls") ' CHANGE TO SUIT Set Ws = Wb.Worksheets.Item(1) Dim arrWs() As Variant: Let arrWs() = Ws.Range("A1").CurrentRegion.Value2 Dim Lr As Long: Let Lr = UBound(arrWs(), 1) Rem 2 text File Info, Import into Excel Array Dim PathAndFileName As String, TotalFile As String ' Let PathAndFileName = ThisWorkbook.Path & "\" & "Alert 24 Mai..csv" ' Let PathAndFileName = ThisWorkbook.Path & Application.PathSeparator & "Sample2.csv" ' "sample2 ef 5 June.csv" ' CHANGE TO SUIT From Avinash : https://excelfox.com/forum/showthread.php/2505-copy-paste-the-data-if-condition-matches?p=13470&viewfull=1#post13470 sample2 ef 5 June.csv : https://app.box.com/s/0j4118cwzzofe76ytb5rqkvz3qj0vseu ' 2a)(i) Determine rows (records) wanted, based on ... First column(field) not being empty Dim RwCnt As Long, TextFileLineIn As String Dim FileNum As Long: Let FileNum = FreeFile(1) ' https://msdn.microsoft.com/en-us/vba/language-reference-vba/articles/freefile-function Open PathAndFileName For Input As #FileNum 'Open Route to data Line Input #FileNum, TextFileLineIn ' First line Do While Left(TextFileLineIn, 4) = "NSE," ' For text file lines like NSE,101010,6,<,12783,A,,,,,GTT Let RwCnt = RwCnt + 1 Line Input #FileNum, TextFileLineIn ' next line in text file Loop Close #FileNum ' 2a)(ii) get the text file as a long single string Let FileNum = FreeFile(1) Open PathAndFileName For Binary As #FileNum 'Open Route to data. Binary is a fundemental type data input... Let TotalFile = Space(LOF(FileNum)) '....and wot recives it has to be a string of exactly the right length Get #FileNum, , TotalFile Close #FileNum ' 2b) Split into wholes line _ splitting the text file into rows by splitting by vbCr & vbLf ( Note vbCr & vbLf = vbNewLine ) Dim arrRws() As String: Let arrRws() = Split(TotalFile, vbCr & vbLf, -1, vbBinaryCompare) 'Dim RwCnt As Long: Let RwCnt = UBound(arrRws()) + 1 ' +1 is nedeed as the Split Function returns indicies 0 1 2 3 4 5 etc... ' Alert 24 MaiDotDotcsvBefore.JPG : https://imgur.com/jSZV7Bt , https://imgur.com/ckS9Rzq ' 2c) ' we can now make an array for all the rows, and we know our columns are A-K = 11 columns Dim arrIn() As String: ReDim arrIn(1 To RwCnt, 1 To 11) Dim Cnt As Long For Cnt = 1 To RwCnt ' _.. considering each row of data but only those up to Rwcnt Dim arrClms() As String Let arrClms() = Split(arrRws(Cnt - 1), ",", -1, vbBinaryCompare) ' ___.. splitting each row into columns by splitting by the comma Dim Clm As Long ' For Clm = 1 To 11 'For Clm = 1 To UBound(arrClms()) + 1 Let arrIn(Cnt, Clm) = arrClms(Clm - 1) Dim TruncRw As String '_- Let TruncRw = TruncRw & arrIn(Cnt, Clm) & "," '_- The idea of this is a bodge to get rid of a lot of extra ,,,,,,, if we have empty cells being used, as in Avinash original - sample2.csv : https://app.box.com/s/0ej2h41g9fvm94cflf2j60a8o6p3334t - https://excelfox.com/forum/showthread.php/2345-Appendix-Thread-(-Codes-for-other-Threads-HTML-Tables-etc-)?p=13475&viewfull=1#post13475 Next Clm Let arrRws(Cnt - 1) = Left(TruncRw, Len(TruncRw) - 1) '_- take off the last , Let TruncRw = "" Next Cnt ' 2d) Re make text string of just rows to RwCnt ReDim Preserve arrRws(0 To RwCnt - 1) Dim TotalFileToRwCnt As String Let TotalFileToRwCnt = Join(arrRws(), vbCr & vbLf) & vbCr & vbLf ' This is effectively our long string text file and an extra final carriage return and line feed ' 2d) second column in text file, up to RwCnt Dim Clm2() As Variant: Let Clm2() = Application.Index(arrIn(), 0, 2) ' https://excelfox.com/forum/showthread.php/1111-VBA-Trick-of-the-Week-Slicing-an-Array-Without-Loop-%e2%80%93-Application-Index Clm2Sample2csv.JPG : https://imgur.com/DYYAl3z Rem 3 Do it For Cnt = 2 To Lr ' 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 (arrWs(Cnt, 11) > arrWs(Cnt, 4) And arrWs(Cnt, 8) > arrWs(Cnt, 11)) Or (arrWs(Cnt, 11) < arrWs(Cnt, 4) And arrWs(Cnt, 8) < arrWs(Cnt, 11)) Then Dim MtchRes As Variant ' for match column I of of Sample1.xls with second data column of text file Sample2.csv Clm2() Let MtchRes = Application.Match(CStr(arrWs(Cnt, 9)), Clm2(), 0) ' match column I of of 1.xls with second column data of text file of Alert..csv ' Match Column I of sample1.xls with second field values (column B) of sample2.csv 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 append second field values (column B) of sample2.csv Let TotalFileToRwCnt = TotalFileToRwCnt & "," & arrWs(Cnt, 9) & ",,,,,,,,,," & vbCr & vbLf ' make the single text string for the output text file End If Else ' Neither of the 2 conditions are met so do nothing End If Next Cnt Rem 5 remake the text file ''5a) make a new text file string 'Dim strTotalFile As String ' Let strTotalFile = Join(arrRwsOut(), vbCr & vbLf) '5b) make new file Let FileNum = FreeFile(1) ' https://msdn.microsoft.com/en-us/vba/language-reference-vba/articles/freefile-function Open ThisWorkbook.Path & "\" & "Sample2After.csv" For Output As #FileNum ' CHANGE TO SUIT ' Will be made if not there Print #FileNum, TotalFileToRwCnt ' strTotalFile Close #FileNum ' Call WtchaGot_Unic_NotMuchIfYaChoppedItOff(TotalFileToRwCnt) 'Rem 6 Check File in Excel VBA open '' Workbooks.Open Filename:=ThisWorkbook.Path & "\" & "Sample2.csv" ' Workbooks.Open Filename:=ThisWorkbook.Path & Application.PathSeparator & "Sample2After.csv" ' CHANGE TO SUIT ' End Sub
sample2.csv : https://app.box.com/s/0ej2h41g9fvm94cflf2j60a8o6p3334t
Sample1.xls : https://app.box.com/s/xh58fgjl74w06hvsd53jriqkohdm6a3q
macro.xlsm : https://app.box.com/s/z358r7tbc9hzthi539dlj49jsf4gyg8p
Sample2After.csv : https://app.box.com/s/0j4118cwzzofe76ytb5rqkvz3qj0vseu
vba.xlsm : https://app.box.com/s/juekenyll42z84j6ms7qonzsngnugoyo
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
Macro to answer this Thread
https://excelfox.com/forum/showthrea...ete-entire-row
Code:Sub STEP9t() ' https://excelfox.com/forum/showthread.php/2520-Conditionally-compare-the-data-amp-delete-entire-row Rem 1 Worksheets info '1_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("1.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) Dim arrS1() As Variant 'Let arrS1() = Ws1.Range("A1").CurrentRegion.Value Let arrS1() = Ws1.Range("A1:J" & Lr1 & "").Value ' Input data range '1_2 Alert.xls Dim Wb2 As Workbook, Ws2 As Worksheet Set Wb2 = Workbooks("Alert.xls") Set Ws2 = Wb2.Worksheets.Item(1) Dim RwCnt2 As Long: Let RwCnt2 = Ws2.Range("A" & Ws2.Rows.Count & "").End(xlUp).Row '1_2d) second column in Alert.xls Dim Clm2() As Variant: Let Clm2() = Ws2.Range("B1:B" & RwCnt2 & "").Value Rem 3 Dim Cnt As Long, MtchRes As Variant For Cnt = UBound(arrS1(), 1) To 2 Step -1 ' "row" count, Cnt Select Case arrS1(Cnt, 10) ' column I Case "BUY" 'If column J of 1.xls has buy then If arrS1(Cnt, 8) < arrS1(Cnt, 4) Then ' column H of 1.xls is not greater than column D of 1.xls Let MtchRes = Application.Match(arrWs1(Cnt, 9), Clm2(), 0) ' match column I data of 1.xls with column B of alert.xls If IsError(MtchRes) Then ' no match result so do nothing Else Ws2.Range("A" & MtchRes & ":K" & MtchRes & "").Delete shift:=xlUp ' delete that entire row of alert.xls End If: Else End If Case "" ' If column J of 1.xls has a blank cell then Let MtchRes = Application.Match(arrWs1(Cnt, 9), Clm2(), 0) ' match column I data of 1.xls with column B of alert.xls If IsError(MtchRes) Then ' no match result so do nothing Else Ws2.Range("A" & MtchRes & ":K" & MtchRes & "").Delete shift:=xlUp ' delete that entire row of alert.xls End If Case "SHORT" 'If column J is SHORT then If arrS1(Cnt, 8) > arrS1(Cnt, 4) Then ' column H of 1.xls is Greater than than column D Let MtchRes = Application.Match(arrWs1(Cnt, 9), Clm2(), 0) ' match column I data of 1.xls with column B of alert.xls If IsError(MtchRes) Then ' no match result so do nothing Else Ws2.Range("A" & MtchRes & ":K" & MtchRes & "").Delete shift:=xlUp ' delete that entire row of alert.xls End If Else End If End Select Next Cnt End Sub
macro.xlsm : https://app.box.com/s/z358r7tbc9hzthi539dlj49jsf4gyg8p
1.xls : https://app.box.com/s/38aoip5xi7018y9syt0xe4g04u95l6xk
Alert.xls : https://app.box.com/s/ectstkrcfnuozys9tmdd0qi3tdvyxb3w
Macro for this post:
https://excelfox.com/forum/showthrea...ata-if-matches
Code:Sub AddColumnJValueInWs1basedOnMatchAndCritzeriaInWs2() ' https://excelfox.com/forum/showthread.php/2556-copy-and-paste-of-data-if-matches Rem 1 Worksheets info '1_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("1.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) '1_1b) data range Dim arrS1() As Variant 'Let arrS1() = Ws1.Range("A1").CurrentRegion.Value Let arrS1() = Ws1.Range("A1:J" & Lr1 & "").Value ' Input data range '1_2 AlertCodes.xlsx Dim WbA As Workbook, WsA4 As Worksheet Set WbA = Workbooks("AlertCodes.xlsx") Set WsA4 = WbA.Worksheets.Item(4) Dim RwCnt4 As Long: Let RwCnt4 = WsA4.Range("A" & WsA4.Rows.Count & "").End(xlUp).Row '1_2b) dataa range Dim arrWsA4() As Variant: Let arrWsA4() = WsA4.Range("A1:K" & RwCnt4 & "").Value2 '1_2d) second column in Alertcodes.xlsx Dim ClmB() As Variant: Let ClmB() = WsA4.Range("B1:B" & RwCnt4 & "").Value Rem 3 Dim Cnt As Long For Cnt = 2 To Lr1 ' going down "rows" in 1.xls Dim MtchRes As Variant Let MtchRes = Application.Match(arrWs1(Cnt, 9), ClmB(), 0) ' match column I of 1.xls with sheet4 of column B of Alertcodes.xlsx If IsError(MtchRes) Then ' do nothing - no match Else ' look at symbol in column D, 4th worksheet of AlertCodes.xlsx for that matched row in column D, 4th worksheet of AlertCodes.xlsx If arrWsA4(MtchRes, 4) = ">" Then ' If symbol is > then Let arrS1(Cnt, 10) = "SHORT" ' put SHORT in column J of 1.xls for the matched row ElseIf arrWsA4(MtchRes, 4) = "<" Then ' If symbol < then Let arrS1(Cnt, 10) = "BUY" ' put BUY in column J of 1.xls for the matched row Else End If End If Next Cnt Rem 4 Paste back out arrS1() Let Ws1.Range("A1:J" & Lr1 & "").Value2 = arrS1() End Sub
AlertCodes.xlsx : https://app.box.com/s/jwpjjut9wt3ej7dbns3269ftlpdr7xsm
1.xls : https://app.box.com/s/38aoip5xi7018y9syt0xe4g04u95l6xk
Vba.xlsm : https://app.box.com/s/lf6otsrl42m6vxxvycjo04zidya6pd2m
In support of these posts
https://excelfox.com/forum/showthrea...ll=1#post13617
https://excelfox.com/forum/showthrea...ll=1#post13470
sample2BEFORE.csv
NSE,101010,6,<,12783,A,,,,,GTT
NSE,22,6,<,12783,A,,,,,GTT
NSE,17388,6,<,12783,A,,,,,GTT
Code:"NSE" & "," & "101010" & "," & "6" & "," & Chr(60) & "," & "12783" & "," & "A" & "," & "," & "," & "," & "," & "GTT" & vbCr & vbLf & "NSE" & "," & "22" & "," & "6" & "," & Chr(60) & "," & "12783" & "," & "A" & "," & "," & "," & "," & "," & "GTT" & vbCr & vbLf & "NSE" & "," & "17388" & "," & "6" & "," & Chr(60) & "," & "12783" & "," & "A" & "," & "," & "," & "," & "," & "GTT" & vbCr & vbLfsampLE2AFTER.csvCode:"NSE" & "," & "101010" & "," & "6" & "," & Chr(60) & "," & "12783" & "," & "A" & "," & "," & "," & "," & "," & "GTT" & vbCr & vbLf & "NSE" & "," & "22" & "," & "6" & "," & Chr(60) & "," & "12783" & "," & "A" & "," & "," & "," & "," & "," & "GTT" & vbCr & vbLf & "NSE" & "," & "17388" & "," & "6" & "," & Chr(60) & "," & "12783" & "," & "A" & "," & "," & "," & "," & "," & "GTT" & vbCr & vbLf
NSE,101010,6,<,12783,A,,,,,GTT
NSE,22,6,<,12783,A,,,,,GTT
NSE,17388,6,<,12783,A,,,,,GTT
,100,,,,,,,,,
,25,,,,,,,,,
Code:"NSE" & "," & "101010" & "," & "6" & "," & Chr(60) & "," & "12783" & "," & "A" & "," & "," & "," & "," & "," & "GTT" & vbCr & vbLf & "NSE" & "," & "22" & "," & "6" & "," & Chr(60) & "," & "12783" & "," & "A" & "," & "," & "," & "," & "," & "GTT" & vbCr & vbLf & "NSE" & "," & "17388" & "," & "6" & "," & Chr(60) & "," & "12783" & "," & "A" & "," & "," & "," & "," & "," & "GTT" & vbCr & vbLf & "," & "100" & "," & "," & "," & "," & "," & "," & "," & "," & "," & vbCr & vbLf & "," & "25" & "," & "," & "," & "," & "," & "," & "," & "," & "," & vbCr & vbLfCode:"NSE" & "," & "101010" & "," & "6" & "," & Chr(60) & "," & "12783" & "," & "A" & "," & "," & "," & "," & "," & "GTT" & vbCr & vbLf & "NSE" & "," & "22" & "," & "6" & "," & Chr(60) & "," & "12783" & "," & "A" & "," & "," & "," & "," & "," & "GTT" & vbCr & vbLf & "NSE" & "," & "17388" & "," & "6" & "," & Chr(60) & "," & "12783" & "," & "A" & "," & "," & "," & "," & "," & "GTT" & vbCr & vbLf & "," & "100" & "," & "," & "," & "," & "," & "," & "," & "," & "," & vbCr & vbLf & "," & "25" & "," & "," & "," & "," & "," & "," & "," & "," & "," & vbCr & vbLf
https://excelfox.com/forum/showthrea...ll=1#post13617
sampLE2AFTER.csv : https://drive.google.com/file/d/1Tyf...gWwzZ3s43YxzwA
sample2BEFORE : https://drive.google.com/file/d/1X2M...vIqNATRC34o5hD
app.box.com
Share ‘sample2BEFORE.csv’ : https://app.box.com/s/d8lu7iatfv6h8spp9eru8asm3h4v4e4p
Share ‘Sample2After.csv’ : https://app.box.com/s/0j4118cwzzofe76ytb5rqkvz3qj0vseu
Previous files:
sample2.csv : https://app.box.com/s/0ej2h41g9fvm94cflf2j60a8o6p3334t
Sample1.xls : https://app.box.com/s/xh58fgjl74w06hvsd53jriqkohdm6a3q
macro.xlsm : https://app.box.com/s/z358r7tbc9hzthi539dlj49jsf4gyg8p
Sample2After.csv : https://app.box.com/s/0j4118cwzzofe76ytb5rqkvz3qj0vseu
vba.xlsm : https://app.box.com/s/juekenyll42z84j6ms7qonzsngnugoyo
Macro for this post:
https://excelfox.com/forum/showthrea...ll=1#post13617
Code:Sub VBAAppendDataToTextFileLineBasedOnTheTextFileAndExcelFileConditions2() ' https://excelfox.com/forum/showthread.php/2505-copy-paste-the-data-if-condition-matches?p=13616&viewfull=1#post13616 Rem 1 Workbook, Worksheet info ( Excel File ) Dim Wb As Workbook, Ws As Worksheet ' Set Wb = Workbooks.Open(ThisWorkbook.Path & "\" & "Sample1.xls") ' Set Wb = Workbooks.Open(ThisWorkbook.Path & Application.PathSeparator & "Sample1.xls") Set Wb = Workbooks("1.xls") ' Workbooks("Sample1.xls") ' CHANGE TO SUIT Set Ws = Wb.Worksheets.Item(1) Dim arrWs() As Variant: Let arrWs() = Ws.Range("A1").CurrentRegion.Value2 Dim LR As Long: Let LR = UBound(arrWs(), 1) Rem 2 text File Info, Import into Excel Array Dim PathAndFileName As String, TotalFile As String ' Let PathAndFileName = ThisWorkbook.Path & "\" & "Alert 24 Mai..csv" ' Let PathAndFileName = ThisWorkbook.Path & Application.PathSeparator & "sample2BEFORE.csv" ' "sample2_9June.csv" ' "sample2 8June.csv" ' "Sample2.csv" ' "sample2 ef 5 June.csv" ' CHANGE TO SUIT From Avinash : https://excelfox.com/forum/showthread.php/2505-copy-paste-the-data-if-condition-matches?p=13470&viewfull=1#post13470 sample2 ef 5 June.csv : https://app.box.com/s/0j4118cwzzofe76ytb5rqkvz3qj0vseu ' 2a)(i) Determine rows (records) wanted, based on ... First column(field) not being empty Dim RwCnt As Long, TextFileLineIn As String Dim FileNum As Long: Let FileNum = FreeFile(1) ' https://msdn.microsoft.com/en-us/vba/language-reference-vba/articles/freefile-function Open PathAndFileName For Input As #FileNum 'Open Route to data Line Input #FileNum, TextFileLineIn ' First line Do While Not EOF(FileNum) = True And Left(TextFileLineIn, 4) = "NSE," ' Left(TextFileLineIn, 4) = "NSE," ' For text file lines like NSE,101010,6,<,12783,A,,,,,GTT that may have extra unwanted lines like in one Avinash uses stupidly for explanations Let RwCnt = RwCnt + 1 ' for first and subsequent lines given by below. ... but Line Input #FileNum, TextFileLineIn ' next line in text file Loop If EOF(FileNum) = True Then Let RwCnt = RwCnt + 1 ' ... but if the last line I want is EOF, I will not catch it in the loop so must add a 1 here Close #FileNum ' 2a)(ii) get the text file as a long single string Let FileNum = FreeFile(1) Open PathAndFileName For Binary As #FileNum 'Open Route to data. Binary is a fundemental type data input... Let TotalFile = Space(LOF(FileNum)) '....and wot recives it has to be a string of exactly the right length Get #FileNum, , TotalFile Close #FileNum ' 2b) Split into wholes line _ splitting the text file into rows by splitting by vbCr & vbLf ( Note vbCr & vbLf = vbNewLine ) Dim arrRws() As String: Let arrRws() = Split(TotalFile, vbCr & vbLf, -1, vbBinaryCompare) 'Dim RwCnt As Long: Let RwCnt = UBound(arrRws()) + 1 ' +1 is nedeed as the Split Function returns indicies 0 1 2 3 4 5 etc... ' Alert 24 MaiDotDotcsvBefore.JPG : https://imgur.com/jSZV7Bt , https://imgur.com/ckS9Rzq ' 2c) ' we can now make an array for all the rows, and we know our columns are A-K = 11 columns Dim arrIn() As String: ReDim arrIn(1 To RwCnt, 1 To 11) Dim Cnt As Long For Cnt = 1 To RwCnt ' _.. considering each row of data but only those up to Rwcnt Dim arrClms() As String Let arrClms() = Split(arrRws(Cnt - 1), ",", -1, vbBinaryCompare) ' ___.. splitting each row into columns by splitting by the comma Dim Clm As Long ' For Clm = 1 To 11 'For Clm = 1 To UBound(arrClms()) + 1 Let arrIn(Cnt, Clm) = arrClms(Clm - 1) Dim TruncRw As String '_- Let TruncRw = TruncRw & arrIn(Cnt, Clm) & "," '_- The idea of this is a bodge to get rid of a lot of extra ,,,,,,, if we have empty cells being used, as in Avinash original - sample2.csv : https://app.box.com/s/0ej2h41g9fvm94cflf2j60a8o6p3334t - https://excelfox.com/forum/showthread.php/2345-Appendix-Thread-(-Codes-for-other-Threads-HTML-Tables-etc-)?p=13475&viewfull=1#post13475 Next Clm Let arrRws(Cnt - 1) = Left(TruncRw, Len(TruncRw) - 1) '_- take off the last , Let TruncRw = "" '_- so this can be used again for next line(row) Next Cnt ' 2d) Re make text string of just rows to RwCnt ReDim Preserve arrRws(0 To RwCnt - 1) Dim TotalFileToRwCnt As String Let TotalFileToRwCnt = Join(arrRws(), vbCr & vbLf) & vbCr & vbLf ' This is effectively our long string text file and an extra final carriage return and line feed ' 2d) second column in text file, up to RwCnt Dim Clm2() As Variant: Let Clm2() = Application.Index(arrIn(), 0, 2) ' https://excelfox.com/forum/showthread.php/1111-VBA-Trick-of-the-Week-Slicing-an-Array-Without-Loop-%e2%80%93-Application-Index Clm2Sample2csv.JPG : https://imgur.com/DYYAl3z Rem 3 Do it For Cnt = 2 To LR ' 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 (arrWs(Cnt, 11) > arrWs(Cnt, 4) And arrWs(Cnt, 8) > arrWs(Cnt, 11)) Or (arrWs(Cnt, 11) < arrWs(Cnt, 4) And arrWs(Cnt, 8) < arrWs(Cnt, 11)) Then Dim MtchRes As Variant ' for match column I of of Sample1.xls with second data column of text file Sample2.csv Clm2() Let MtchRes = Application.Match(CStr(arrWs(Cnt, 9)), Clm2(), 0) ' match column I of of 1.xls with second column data of text file of Alert..csv ' Match Column I of sample1.xls with second field values (column B) of sample2.csv 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 append second field values (column B) of sample2.csv Let TotalFileToRwCnt = TotalFileToRwCnt & "," & arrWs(Cnt, 9) & ",,,,,,,,,," & vbCr & vbLf ' make the single text string for the output text file End If Else ' Neither of the 2 conditions are met so do nothing End If Next Cnt Rem 5 remake the text file ''5a) make a new text file string 'Dim strTotalFile As String ' Let strTotalFile = Join(arrRwsOut(), vbCr & vbLf) '5b) make new file Let FileNum = FreeFile(1) ' https://msdn.microsoft.com/en-us/vba/language-reference-vba/articles/freefile-function Open ThisWorkbook.Path & "\" & "Sample2After.csv" For Output As #FileNum ' CHANGE TO SUIT ' Will be made if not there Print #FileNum, TotalFileToRwCnt ' strTotalFile Close #FileNum ' Call WtchaGot_Unic_NotMuchIfYaChoppedItOff(TotalFileToRwCnt) Rem 6 Check File in Excel VBA open ' Workbooks.Open Filename:=ThisWorkbook.Path & "\" & "Sample2.csv" ' Workbooks.Open Filename:=ThisWorkbook.Path & Application.PathSeparator & "Sample2After.csv" ' CHANGE TO SUIT 'Dim Wb As Workbook ' Set Wb = Workbooks.Open("C:\Users\WolfieeeStyle\Desktop\sample2.csv") End Sub
Share ‘sample2BEFORE.csv’ : https://app.box.com/s/d8lu7iatfv6h8spp9eru8asm3h4v4e4p
Share ‘Sample2After.csv’ : https://app.box.com/s/0j4118cwzzofe76ytb5rqkvz3qj0vseu
vba.xlsm : https://app.box.com/s/juekenyll42z84j6ms7qonzsngnugoyo
Sample1.xls : https://app.box.com/s/xh58fgjl74w06hvsd53jriqkohdm6a3q
macro.xlsm : https://app.box.com/s/z358r7tbc9hzthi539dlj49jsf4gyg8p
1.xls : https://app.box.com/s/38aoip5xi7018y9syt0xe4g04u95l6xk
Posting Permissions
Reply With Quote
Bookmarks