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

**DocAElstein** · 05-24-2020, 12:58 PM

Macro for this Thread post
https://excelfox.com/forum/showthrea...ll=1#post13423

Calculate 2% of colum H & column I & considered the greater number between them
column S should be positive, so don’t considere the no. which are negative
& if column S is lower than that 2% of column H or Column I (whichever is greater )then put -1
vba macro will be placed in a seperate file , sheet name can be anything, all files are located in different place
example
the U2 cell will become -1 after runing the macro

Code:

Sub CalculationByPercentageAndConditionallyPutingTheData() '  https://excelfox.com/forum/showthread.php/2499-calculation-by-percentage-and-conditionally-puting-the-data?p=13423&viewfull=1#post13423
Rem worksheets info
'  ap.xls
Dim Wbap As Workbook
 Set Wbap = Workbooks("ap.xls")
Dim Wsap As Worksheet
 Set Wsap = Wbap.Worksheets.Item(1)
Dim Lrap As Long: Let Lrap = Wsap.Range("B" & Wsap.Rows.Count & "").End(xlUp).Row  '   http://www.excelfox.com/forum/showthread.php/2345-Appendix-Thread-(-Codes-for-other-Threads-HTML-Tables-etc-)?p=11466&viewfull=1#post11466      Making Lr dynamic ( using rng.End(XlUp) for a single column. )
Dim Arrap As Variant: Let Arrap = Wsap.Range("A1:Y" & Lrap & "").Value2
' 1b) Evaluate range H and I at 2%   -     Calculate 2% of colum H & column I
Dim arrH2pc() As Variant, arrI2pc() As Variant
 Let arrH2pc() = Evaluate("=2/100*H2:H" & Lrap & "")
 Let arrI2pc() = Evaluate("=2/100*I2:I" & Lrap & "")

Rem 2
Dim arrS() As Variant: Let arrS() = Wsap.Range("S1:S" & Lrap & "").Value2
Dim arrU() As Variant: Let arrU() = Wsap.Range("U1:U" & Lrap & "").Value2
Dim Cnt As Long
    For Cnt = 2 To Lrap
        If arrS(Cnt, 1) >= 0 Then
        Dim BgstHI As Double           '             colum H & column I & considered the greater number between them
        Let BgstHI = arrH2pc(Cnt - 1, 1)   '                                                                                                                         Cnt - 1  is  because our arrays for the H and I columns start at row 2 , so the indices will be one less than the roe to which they apply . I chose to do this to avoid trying to get 2% of the header , as that would error
            If arrH2pc(Cnt - 1, 1) < arrI2pc(Cnt - 1, 1) Then Let BgstHI = arrI2pc(Cnt - 1, 1) '  If I column is largest, use that, otherwise H will be taken   NOTE: H will be taken if the H and I columnns are equal
            If arrS(Cnt, 1) < BgstHI Then Let arrU(Cnt, 1) = -1
        Else ' S < 0
        '  column S should be positive, so don’t considere the no. which are negative
        End If
    Next Cnt
    
Rem 3 paste out
 Let Wsap.Range("U1:U" & Lrap & "").Value2 = arrU()
End Sub

arrHISU.JPG : https://imgur.com/uunxENf
Attachment 2954

Share ‘macro.xlsm’ : https://app.box.com/s/599q2it3uck3hfwm5kscmmgtn0be66wt
Share ‘ap.xls’ : https://app.box.com/s/pq6nqkfilk2xs5lf19ozcpx081rp47vs

**DocAElstein** · 05-24-2020, 11:14 PM

macro for this post http://www.eileenslounge.com/viewtop...268809#p268809

Code:

'                                                                              From vixer zyxw1234 Avinash : http://www.eileenslounge.com/viewtopic.php?f=30&t=34629     DF.txt https://app.box.com/s/gw941dh9v8sqhvzin3lo9rfc67fjsbic                           Excel File, https://app.box.com/s/yyzt8ywwpkkn8vxtxumalp7eg3888jnu  Sample1.xlsx
Sub TextFileToExcel()  '  http://www.eileenslounge.com/viewtopic.php?p=268809#p268809
Rem 1 Workbooks,  Worksheets info
Dim Wb As Workbook, Ws As Worksheet
 Set Wb = Workbooks("Sample1.xlsx") ' CHANGE TO SUIT
 Set Ws = Wb.Worksheets.Item(1)     ' first worksheet
Dim lr As Long: Let lr = Ws.Range("A" & Ws.Rows.Count & "").End(xlUp).Row       '   http://www.excelfox.com/forum/showthread.php/2345-Appendix-Thread-(-Codes-for-other-Threads-HTML-Tables-etc-)?p=11466&viewfull=1#post11466      Making Lr dynamic ( using rng.End(XlUp) for a single column. )
Dim NxtRw As Long
    If lr = 1 And Ws.Range("A1").Value = "" Then
     Let NxtRw = 1      '  If there is no data in the worksheet we want the first row to be the start row
    Else
     Let NxtRw = lr + 1 ' If there is data in the worksheet, we ant the data to be posted after the last used row
    End If
Rem 2 Text file info
' 2a) get the text file as a long single string
Dim FileNum As Long: Let FileNum = FreeFile(1)                                  ' https://msdn.microsoft.com/en-us/vba/language-reference-vba/articles/freefile-function
Dim PathAndFileName As String, TotalFile As String
 Let PathAndFileName = ThisWorkbook.Path & "\csv Text file Chaos\" & "DF.txt"   '    CHANGE TO SUIT   From vixer zyxw1234  : http://www.eileenslounge.com/viewtopic.php?f=30&t=34629     DF.txt https://app.box.com/s/gw941dh9v8sqhvzin3lo9rfc67fjsbic
Open PathAndFileName For Binary As #FileNum 'Open Route to data. Binary is a fundemental type data input...
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...
' we can now make an array for all the rows, and we know our columns are A-J = 10 columns
Dim arrOut() As String: ReDim arrOut(1 To RwCnt, 1 To 10)

Rem 3 An array is built up by _....
Dim Cnt As Long
    For Cnt = 1 To RwCnt '               _.. considering each row of data
    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 UBound(arrClms()) + 1
         Let arrOut(Cnt, Clm) = arrClms(Clm - 1)
        Next Clm
    Next Cnt

Rem 4  Finally the array is pasted to the worksheet at the next free row
 Let Ws.Range("A" & NxtRw & "").Resize(RwCnt, 10).Value = arrOut()
End Sub

Share ‘sample1.xlsx’ : https://app.box.com/s/r0tc0hkwoxrqjsqfu4gh7eqyy5jmqlg2
Share ‘macro.xlsm’ : https://app.box.com/s/599q2it3uck3hfwm5kscmmgtn0be66wt

**DocAElstein** · 05-25-2020, 02:44 PM

In support of this Thread https://excelfox.com/forum/showthrea...3427#post13427

If column H of 1.xls is greater than column D of 1.xls then calculate 1% of column D of 1.xls & add it to column D of 1.xls and compare column D of 1.xls with column I of 1.xls & if column D of 1.xls is greater than column I of 1.xls then see column I and match column I of of 1.xls with column B of Alert..csv & if it matches then delete that entire row of Alert..csv
If column H of 1.xls is lower than column D of 1.xls then calculate 1% of column D of 1.xls & subtract it to column D of 1.xls and compare column D of 1.xls with column I of 1.xls & if column D of 1.xls is lower than column I then see column I of 1.xls and match column I of of 1.xls with column B of Alert..csv & if it matches then delete that entire row of Alert..csv

Excel File:
_____ Workbook: 1.xls ( Using Excel 2007 32 bit )

_Row\^Col	A	B	C	D	E	F	G	H	I
1	Exchange	Symbol	Series/Expiry	Open	High	Low	Prev Close	LTP
2	NSE	ACC	EQ	1172	1240	1161.6	1227.1	1227.1	22
3	NSE	ADANIENT	EQ	138	141.2	136.6	138.1	140	25
4	NSE	ADANIPORTS	EQ	315	315	306.55	310.6	312	15083
5	NSE	ADANIPOWER	EQ	33.5	34.5	32.85	33	33.2	17388
6	NSE	AMARAJABAT	EQ	600	613.5	586.9	592.55	592.55	100
7	NSE	ASIANPAINT	EQ	1568.8	1625	1555.4	1617.9	1617.9	236

Worksheet: 1-Sheet1 24Mai

Text File:

Code:

NSE,236,6,>,431555,A,,,,,GTT
NSE,25,6,>,431555,A,,,,,GTT
NSE,15083,6,>,431555,A,,,,,GTT
NSE,17388,6,>,431555,A,,,,,GTT
NSE,100,6,>,431555,A,,,,,GTT
NSE,22,6,>,431555,A,,,,,GTT
,,,,,,,,,,
,,,,,,,,,,
,,,,,,,,,,
,,,,,,,,,,
,,,,,,,,,,
,,,,,,,,,,
,,,,,,,,,,
,,,,,Entire row of row 3 & row 4 both will be deleted after runing the macro,,,,,

Row in 1.xls
2	Column H is > column D Column D + 1% is > Column I 22 is matched to last line of data in Text File. So last line in data File should be removed.
3	Column H is > column D Column D + 1% is > Column I 25 is matched to second line of data in Text File. So thisline in data File should be removed.
4	Column H is < Column D Column D - 1% is < Column I 15083 is matched to third line of Text File. So this line is to be deleted
5	Column H is < Column D Column D - 1% is < Column I 17388 is matched to forth line of Text File. So this line is to be deleted
6	Column H is < Column D Column D - 1% is not < Column I so no match to be done , nothing more to be done
7	Column H is > column D Column D + 1% is > Column I 236 is matched to first line of data in Text File. So first line in data File should be removed.

Text File after

Code:

NSE,100,6,>,431555,A,,,,,GTT
,,,,,,,,,,
,,,,,,,,,,
,,,,,,,,,,
,,,,,,,,,,
,,,,,,,,,,
,,,,,,,,,,
,,,,,,,,,,
,,,,,Entire row of row 3 & row 4 both will be deleted after runing the macro,,,,,

**DocAElstein** · 05-25-2020, 03:05 PM

Macro solution for this post: https://excelfox.com/forum/showthrea...3427#post13427

Code:

'  https://excelfox.com/forum/showthread.php/2500-Conditionally-delete-entire-row-with-calculation-within-files?p=13427#post13427

Sub VBARemoveTextFileLineBasedOnExcelFileConditions()
Rem 1 Workbook, Worksheet info ( Excel File )
Dim Wb As Workbook, Ws As Worksheet
 Set Wb = Workbooks("1.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
' 2a) get the text file as a long single string
Dim FileNum As Long: Let FileNum = FreeFile(1)                                  ' https://msdn.microsoft.com/en-us/vba/language-reference-vba/articles/freefile-function
Dim PathAndFileName As String, TotalFile As String
 Let PathAndFileName = ThisWorkbook.Path & "\csv Text file Chaos\" & "Alert 24 Mai..csv"   ' CHANGE TO SUIT    From vixer  : https://excelfox.com/forum/showthread.php/2500-Conditionally-delete-entire-row-with-calculation-within-files?p=13427#post13427     Share ‘Alert 24 Mai..csv’   https://app.box.com/s/599q2it3uck3hfwm5kscmmgtn0be66wt
Open PathAndFileName For Binary As #FileNum 'Open Route to data. Binary is a fundemental type data input...
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
    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 UBound(arrClms()) + 1
         Let arrIn(Cnt, Clm) = arrClms(Clm - 1)
        Next Clm
    Next Cnt
'  arrIn.jpg : https://imgur.com/agGbjHv
' 2d) second column in text file
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    Clm2.jpg :  https://imgur.com/Z6jYp3V

Rem 3 Do it
Dim IndDel As String: Let IndDel = " "  ' for indices to be deleted from rows out array  ''_-  an extra " " at the beginning : A spacee before means I will always get a corrent check of a number in the string
    For Cnt = 2 To Lr ' considering each data row in  1.xls
    Dim D1pc As Double ' for  calculate 1% of column D of 1.xls
    Dim MtchRes As Variant ' for match column I of of 1.xls with second data column of text file Alert..csv  Clm2()
        If arrWs(Cnt, 8) > arrWs(Cnt, 4) Then      '    If column H of 1.xls is greater than column D of 1.xls then
         Let D1pc = 1 / 100 * arrWs(Cnt, 4) ' calculate 1% of column D of 1.xls .._
         Let arrWs(Cnt, 4) = arrWs(Cnt, 4) + D1pc '              _.. & add it to column D of 1.xls
            If arrWs(Cnt, 4) > arrWs(Cnt, 9) Then ' If column D of 1.xls is greater than column I of 1.xls
             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
                If IsError(MtchRes) Then
                ' no match do nothing
                Else
                 Let IndDel = IndDel & MtchRes - 1 & " " ' add an indicee of a row to be deleted
                End If
            Else
            ' column D of 1.xls is not greater than column I of 1.xls
            End If
        
        ElseIf arrWs(Cnt, 8) < arrWs(Cnt, 4) Then  '    If column H of 1.xls is lower than column D of 1.xls then
         Let D1pc = 1 / 100 * arrWs(Cnt, 4) ' calculate 1% of column D of 1.xls .._
         Let arrWs(Cnt, 4) = arrWs(Cnt, 4) - D1pc  '  &          _..  subtract it to column D of 1.xls
            If arrWs(Cnt, 4) < arrWs(Cnt, 9) Then ' If column D of 1.xls is lower than column I of 1.xls
             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
                If IsError(MtchRes) Then
                ' no match do nothing
                Else
                 Let IndDel = IndDel & MtchRes - 1 & " " ' add an indicee of a row to be deleted
                End If
            Else
            ' column D of 1.xls is not lower than column I of 1.xls
            End If
        Else
        ' column H of 1.xls is = column D of 1.xls
        End If ' end of column H compare to column D
    Next Cnt

Rem 4 remake the text file row array
Dim arrRwsOut() As String  ' array for making a new text file
Dim RwsOut As Long ' for row count in modified outpur rows array, arrrwsOut()
Dim RwDelCnt As Long: Let RwDelCnt = (Len(IndDel) - Len(Replace(IndDel, " ", "", 1, -1, vbBinaryCompare))) - 1 '  -1 because of an extra " " at the beginning - ''_-  an extra " " at the beginning : A spacee before means I will always get a corrent check of a number in the string
ReDim arrRwsOut(0 To UBound(arrRws()) - RwDelCnt)
    For Cnt = 0 To UBound(arrRws())
     If InStr(1, IndDel, " " & Cnt & " ", vbBinaryCompare) = 0 Then
      Let arrRwsOut(RwsOut) = arrRws(Cnt)
      Let RwsOut = RwsOut + 1
     Else
     ' do nothing since we are at a row to be deleted
     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 & "\csv Text file Chaos\" & "Alert 24 Mai Out..csv" For Output As #FileNum  ' CHANGE TO SUIT  ' Will be made if not there
 Print #FileNum, strTotalFile
 Close #FileNum

End Sub

Text File given:
Share ‘Alert 24 Mai..csv’ : https://app.box.com/s/599q2it3uck3hfwm5kscmmgtn0be66wt

New text file made after running macro:
Share ‘Alert 24 Mai Out..csv’ : https://app.box.com/s/yseazrdyfloij4ktrhy4ejdpzl0cx02e

Share ‘1.xls’ : https://app.box.com/s/38aoip5xi7018y9syt0xe4g04u95l6xk

Share ‘macro.xlsm’ : https://app.box.com/s/z358r7tbc9hzthi539dlj49jsf4gyg8p

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

test asdsdklj

aslkhSLHDSlhdslhfslkhasklh

ASFJALSKJFASLKJFASLKJFASLKFJALKSJFSLKAJ

lSHFLSHFHSLHF

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

assfhshffhsfskfh

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

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 )

Code:

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 in/ with Excel: ( Like: this: https://imgur.com/7pAaLVx , https://excelfox.com/forum/showthrea...ll=1#post13440 , for example with text editor
OpenSample2_csvManually with Excel.JPG : https://imgur.com/e7CxxpV)
Attachment 2963

_____ Workbook: sample2.csv ( Using Excel 2007 32 bit )

_Row\^Col	A	B
1	NSE,101010,6,<,12783,A,,,,,GTT,,,,,,,,,,,,,
2	NSE,22,6,<,12783,A,,,,,GTT,,,,,,,,,,,,,
3	NSE,17388,6,<,12783,A,,,,,GTT,,,,,,,,,,,,,
4	,100,,,,,,,,,,,,,,,,,,,,,,
5	,25,,,,,,,,,,,,,,,,,,,,,,
6	,,,,,,,,,,,,,,,,,,,,,,,
7	,,,,,,,,,,,,,,,,,,,,,,,
8	,,,,,,,,,,,,,,,,,,,,,,,
9	,,,,,,,,,,,,,,,,,,,,,,,
10	,,,,,,,,,,,,,,,,,,,,,,,
11	,,,,,,,,,,,,,,,,,,,,,,,
12	,,,,,,,,,,,,,,,,,,,,,,,
13	,,,,,,,,,,,,,,,,,,,,,,,
14	,,,,,,,,,,,,,,,,,,,,,,,
15	,,,,,,,,,,,,,,,,,,,,,,,
16	,,,,,,,,,,,,,Only for understanding purpose,,,,,,,,,,
17	,,,,,,,,,,,,,,,,,,,,,,,
18	,,,,,,,,,,,,,Before runing the macro,,,,,,,,,,
19	,,,,,,,,,,,,,,,,,,,,,,,
20	,,,,,,,,,,,,,NSE,101010,6,<,12783,A,,,,,GTT
21	,,,,,,,,,,,,,NSE,22,6,<,12783,A,,,,,GTT
22	,,,,,,,,,,,,,NSE,17388,6,<,12783,A,,,,,GTT
23	,,,,,,,,,,,,,,,,,,,,,,,
24	,,,,,,,,,,,,,,,,,,,,,,,
25	,,,,,,,,,,,,,,,,,,,,,,,
26	,,,,,,,,,,,,,,,,,,,,,,,
27	,,,,,,,,,,,,,After runing the macro,,,,,,,,,,
28	,,,,,,,,,,,,,,,,,,,,,,,
29	,,,,,,,,,,,,,,,,,,,,,,,
30	,,,,,,,,,,,,,,,,,,,,,,,
31	,,,,,,,,,,,,,NSE,101010,6,<,12783,A,,,,,GTT
32	,,,,,,,,,,,,,NSE,22,6,<,12783,A,,,,,GTT
33	,,,,,,,,,,,,,NSE,17388,6,<,12783,A,,,,,GTT
34	,,,,,,,,,,,,,,100,,,,,,,,,
35	,,,,,,,,,,,,,,25,,,,,,,,,
36

Worksheet: sample2

Open with Excel VBA:

Code:

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

see next post : https://excelfox.com/forum/showthrea...ll=1#post13476

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

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

_____ Workbook: sample2.csv ( Using Excel 2007 32 bit )

_Row\^Col	A	B	C	D	E	F	K	N	O	P	Q	R	S	X
1	NSE	101010	6	<	12783	A	GTT
2	NSE	22	6	<	12783	A	GTT
3	NSE	17388	6	<	12783	A	GTT
4		100
5		25
6
7
8
9
10
11
12
13
14
15
16								Only for understanding purpose
17
18								Before runing the macro
19
20								NSE	101010	6	<	12783	A	GTT
21								NSE	22	6	<	12783	A	GTT
22								NSE	17388	6	<	12783	A	GTT
23
24
25
26
27								After runing the macro
28
29
30
31								NSE	101010	6	<	12783	A	GTT
32								NSE	22	6	<	12783	A	GTT
33								NSE	17388	6	<	12783	A	GTT
34									100
35									25

Worksheet: sample2

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

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

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 )

_Row\^Col	A	B
1	NSE,101010,6,<,12783,A,,,,,GTT
2	NSE,22,6,<,12783,A,,,,,GTT
3	NSE,17388,6,<,12783,A,,,,,GTT
4	,100,,,,,,,,,,
5	,25,,,,,,,,,,
6

Worksheet: Sample2After

In Excel VBA

Code:

_ Workbooks.Open Filename:=ThisWorkbook.Path & Application.PathSeparator & "Sample2After.csv" ' CHANGE TO SUIT

_____ Workbook: Sample2After.csv ( Using Excel 2007 32 bit )

_Row\^Col	A	B	C	D	E	F	K
1	NSE	101010	6	<	12783	A	GTT
2	NSE	22	6	<	12783	A	GTT
3	NSE	17388	6	<	12783	A	GTT
4		100
5		25
6

Worksheet: Sample2After

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

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

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