Page 30 of 55 FirstFirst ... 20282930313240 ... LastLast
Results 291 to 300 of 541

Thread: Appendix Thread. 3 *

  1. #291
    Fuhrer, Vierte Reich DocAElstein's Avatar
    Join Date
    Aug 2014
    Posts
    9,521
    Rep Power
    10
    Test ranges used to answer this post:
    https://excelfox.com/forum/showthrea...ll=1#post13401

    Before:

    _____ Workbook: Actual File.xlsx ( Using Excel 2007 32 bit )
    Row\Col
    A
    B
    C
    D
    E
    F
    G
    H
    I
    J
    K
    L
    M
    N
    O
    P
    Q
    1
    Exchange Symbol Series/Expiry Open High Low Prev Close LTP
    2
    NSE ASHOKLEY EQ
    65
    65.35
    60.55
    63.3
    63.3
    1
    1
    60
    1.055
    1.055
    54
    56.97
    3
    NSE BANKBARODA EQ
    62.1
    62.95
    56.15
    56.65
    56.65
    1
    6
    60
    0.944167
    5.665
    54
    50.985
    4
    NSE BEL EQ
    66.15
    66.75
    62.4
    65.65
    65.65
    1
    6
    60
    1.094167
    6.565
    54
    59.085
    5
    NSE EQUITAS EQ
    82
    82.05
    71
    73.05
    73.05
    1
    1
    60
    1.2175
    1.2175
    54
    65.745
    6
    NSE FEDERALBNK EQ
    68
    68.45
    62.45
    63.1
    63.1
    1
    6
    60
    1.051667
    6.31
    54
    56.79
    7
    NSE GAIL EQ
    85
    88.8
    79.1
    79.95
    79.95
    1
    6
    60
    1.3325
    7.995
    54
    71.955
    8
    NSE IDFCFIRSTB EQ
    32.1
    32.35
    27.2
    27.55
    27.55
    1
    60
    0.459167
    0.459167
    54
    24.795
    9
    NSE IOC EQ
    93
    93.65
    87.25
    87.9
    87.9
    1
    60
    1.465
    1.465
    54
    79.11
    10
    NSE L&TFH EQ
    90
    91.55
    80.5
    81.65
    81.65
    6
    51
    1.60098
    9.605882
    54
    86.45294
    11
    Worksheet: Sheet1 (2)

    _____ Workbook: 2.xlsx ( Using Excel 2007 32 bit )
    Row\Col
    A
    B
    C
    D
    E
    F
    G
    H
    I
    J
    K
    L
    M
    N
    O
    1
    Stock Name data data data data data data data data data data data data data data
    2
    ACC
    100
    108
    120
    128
    134
    151
    6534
    30
    90
    97
    103
    3
    ADANIENT
    101
    109
    121
    127
    135
    122
    782
    40
    92
    98
    4
    ADANIPORTS
    102
    110
    122
    16
    137
    177
    10
    50
    93
    99
    104
    5
    ASHOKLEY
    1
    2
    3
    4
    5
    16
    137
    177
    6
    ANJALIPHARMA
    10
    50
    93
    99
    5
    102
    110
    122
    9
    10
    11
    7
    SUNTECK
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    8
    Worksheet: Sheet1 (5)

    _____ Workbook: Actual File.xlsx ( Using Excel 2007 32 bit )
    Row\Col
    O
    P
    Q
    R
    S
    6
    6.31
    54
    56.79
    7
    7.995
    54
    71.955
    Total Fund Amount
    8387.320769
    8
    0.459167
    54
    24.795
    Current Fund Amount
    9000
    9
    1.465
    54
    79.11
    Fund Allocated
    8000
    10
    9.605882
    54
    86.45294
    Profit Amount
    1000
    11
    Sum is
    551.8879
    Worksheet: Sheet1 (2)

    _____ Workbook: Actual File.xlsx ( Using Excel 2007 32 bit )
    Row\Col
    Q
    2
    56.97
    3
    50.985
    4
    59.085
    5
    65.745
    6
    56.79
    7
    71.955
    8
    24.795
    9
    79.11
    10
    86.45294
    11
    =SUM(Q2:Q10)
    Worksheet: Sheet1 (2)


    In this example sum of column Q is less than Range S10 value so nothing is done

  2. #292
    Fuhrer, Vierte Reich DocAElstein's Avatar
    Join Date
    Aug 2014
    Posts
    9,521
    Rep Power
    10
    Macro for last post, and to answer this post:
    https://excelfox.com/forum/showthrea...ll=1#post13401


    Code:
    Sub CopyPaste20Q2b()  ' https://excelfox.com/forum/showthread.php/2494-Copy-and-paste-of-data-if-matches?p=13401&viewfull=1#post13401
    Rem 1 Worksheets info
    ' 2.xlsx
    Dim Wb2 As Workbook
     Set Wb2 = Workbooks("2.xlsx")
    Dim Ws1 As Worksheet: Set Ws1 = Wb2.Worksheets.Item(1)
    Dim Lr1 As Long
     Let Lr1 = Ws1.Range("A" & Ws1.Rows.Count & "").End(xlUp).Row
    Dim arrA() As Variant: Let arrA() = Ws1.Range("A1:A" & Lr1 & "").Value2          '  2.xlsx sheet1 column A
    'Dim Ws2 As Worksheet: Set Ws2 = Wb2.Worksheets.Item(2)
    'Dim Rng22 As Range: Set Rng22 = Ws2.Range("A1").CurrentRegion                    ' Row to be copied - (only first row)entire row of data from sheet2 of 2.xlsx
    
    ' Actual File.xlsx
    Dim Wb As Workbook, Ws As Worksheet
     Set Wb = Workbooks("Actual File.xlsx")
     Set Ws = Wb.Worksheets.Item(1)
    Dim Jmax As Long: Let Jmax = Ws.Range("J" & Ws.Rows.Count & "").End(xlUp).Row
    Dim arrB() As Variant: Let arrB() = Ws.Range("B1:B" & Jmax & "").Value2          ' Actual File.xlsx sheet1 column B
    '1c '  calculate the total value of column Q of ActualFile.xlsx and if it is Greater than S10 of ActualFile.xlsx then
    Dim Lr As Long: Let Lr = Ws.Range("A" & Ws.Rows.Count & "").End(xlUp).Row
    Dim SomeQ As Double: Let SomeQ = Ws.Evaluate("=SUM(Q2:Q" & Lr & ")") '   total value of column Q of ActualFile.xlsx
     Let SomeQ = Application.WorksheetFunction.Round(SomeQ, 2)
    Dim S10Val As Double: Let S10Val = Ws.Range("S10").Value                     '   S10 of ActualFile.xlsx
        If SomeQ > S10Val Then      '  total value of column Q of ActualFile.xlsx and if it is Greater than S10 of ActualFile.xlsx then this macro should do the process
        Rem 2 do it
        Dim Cnt '                                               this is for - going down column A of 2.xlsx sheet1 looking for a match in  Actual File.xlsx sheet1 column B but only as far as JMax
            For Cnt = 2 To Lr1 ' Jmax
            Dim MtchRes As Variant
             Let MtchRes = Application.Match(arrA(Cnt, 1), arrB(), 0)  '    - going down column A of 2.xlsx sheet1 looking for a match in  Actual File.xlsx sheet1 column B
                If IsError(MtchRes) Then
                ' no match  do nothing
                Else ' Cnt is now at the row number of where  2.xlsx sheet1 column A  was found in  Actual File.xlsx sheet1 column B
                Dim Lc1Cnt As Long: Let Lc1Cnt = Ws1.Cells.Item(Cnt, Ws1.Columns.Count).End(xlToLeft).Column
                ' Ws1.Range("B" & Cnt & ":" & CL(Lc1Cnt) & Cnt & "").ClearContents ' clear row Cnt of all data before pasting
                ' Rng22.Copy Destination:=Ws1.Range("B" & Cnt & "")                ' copy the (only first row)entire row of data from sheet2 of 2.xlsx and paste it to the row in  sheet 1 of 2.xlsx  at the row number of the matched value of 2.xlsx sheet1
                 Let Ws1.Range("B" & Cnt & ":" & CL(Lc1Cnt) & Cnt & "").Value = Ws1.Evaluate("=2*" & Ws1.Range("B" & Cnt & ":" & CL(Lc1Cnt) & Cnt & "").Address & "") '   then double the value of that row of 2.xlsx
                End If
            Next Cnt
        Else
        ' else do nothing
        End If
    End Sub

  3. #293
    Fuhrer, Vierte Reich DocAElstein's Avatar
    Join Date
    Aug 2014
    Posts
    9,521
    Rep Power
    10
    Just testing
    ignore all this

    C:\Users

    ror Resume Next
    Set WB1 = Workbooks.Open("C:\Users\WolfieeeStyle\Desktop\1.xls")
    If Err <> 0 Then

  4. #294
    Fuhrer, Vierte Reich DocAElstein's Avatar
    Join Date
    Aug 2014
    Posts
    9,521
    Rep Power
    10
    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
    Attached Images Attached Images

  5. #295
    Fuhrer, Vierte Reich DocAElstein's Avatar
    Join Date
    Aug 2014
    Posts
    9,521
    Rep Power
    10
    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

  6. #296
    Fuhrer, Vierte Reich DocAElstein's Avatar
    Join Date
    Aug 2014
    Posts
    9,521
    Rep Power
    10
    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,,,,,

  7. #297
    Fuhrer, Vierte Reich DocAElstein's Avatar
    Join Date
    Aug 2014
    Posts
    9,521
    Rep Power
    10
    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

  8. #298
    Fuhrer, Vierte Reich DocAElstein's Avatar
    Join Date
    Aug 2014
    Posts
    9,521
    Rep Power
    10
    test asdsdklj




    aslkhSLHDSlhdslhfslkhasklh




    ASFJALSKJFASLKJFASLKJFASLKFJALKSJFSLKAJ

    lSHFLSHFHSLHF

  9. #299
    Fuhrer, Vierte Reich DocAElstein's Avatar
    Join Date
    Aug 2014
    Posts
    9,521
    Rep Power
    10
    assfhshffhsfskfh

  10. #300
    Fuhrer, Vierte Reich DocAElstein's Avatar
    Join Date
    Aug 2014
    Posts
    9,521
    Rep Power
    10
    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
    Attached Images Attached Images

Similar Threads

  1. Replies: 189
    Last Post: 02-06-2025, 02:53 PM
  2. Replies: 603
    Last Post: 05-20-2024, 03:31 PM
  3. Replies: 293
    Last Post: 09-24-2020, 01:53 AM
  4. Appendix Thread. Diet Protokol Coding Adaptions
    By DocAElstein in forum Test Area
    Replies: 6
    Last Post: 09-05-2019, 10:45 AM

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •