Page 28 of 30 FirstFirst ... 182627282930 LastLast
Results 271 to 280 of 294

Thread: Appendix Thread. ( Codes for other Threads, ( Avinash ).)

  1. #271
    Fuhrer, Vierte Reich DocAElstein's Avatar
    Join Date
    Aug 2014
    Posts
    9,315
    Rep Power
    10
    Notes in support of this Thread
    https://excelfox.com/forum/showthrea...ther-workbooks

    _____ 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 ADANIENT EQ 151.85 165.45 151.4 151.85 152.35 25
    3 NSE AMARAJABAT EQ 662.5 665.9 642.55 662.5 643.5 100
    Worksheet: 1-Sheet1 6July

    _____ Workbook: ap.xls ( Using Excel 2007 32 bit )
    Row\Col A B C D E F G H I J K L M N O P Q R S T U V W X Y Z
    1 UserId AccountId EntityName Exchg-Seg Symbol Instrument Name Option Type NetBuyValue NetSellValue NetValue NetBuyQty NetSellQty NetQty BEP SellAvgPrice BuyAvgPrice LastTradedPrice MarkToMarket Realized MarkToMarket Unrealized MarkToMarket EL MarkToMarket Trading Symbol Client Context Series/Expiry Strike Price
    2 WC5758 NSE AMBUJACEM EQ 10781.10 10878.30 97.20 54 54 201.45 199.65 201 97.2 97.2 97.2 AMBUJACEM-EQ EQ
    3 WC5758 NSE ADANIENT EQ 420.60 430.50 9.90 2 2 215.25 210.30 210.35 9.9 9.9 9.9 ADANIENT-EQ EQ 25
    4 WC5758 NSE SIEMENS EQ 2609.30 2642.50 33.20 2 2 1321.25 1304.65 1322.7 33.2 33.2 33.2 SIEMENS-EQ EQ
    5 WC5758 NSE RBLBANK EQ 502.10 530.30 28.20 2 2 265.15 251.05 249.75 28.2 28.2 28.2 RBLBANK-EQ EQ
    6 WC5758 NSE NATIONALUM EQ 1768.50 1782.00 13.50 54 54 33.00 32.75 32.75 13.5 13.5 13.5 NATIONALUM-EQ EQ
    7 WC5758 NSE MARICO EQ 1688.40 1713.00 24.60 6 6 285.50 281.40 281.9 24.6 24.6 24.6 MARICO-EQ EQ
    8 WC5758 NSE AMARAJABAT EQ 2429.10 2405.70 -23.40 18 133.65 134.95 135 -23.4 -23.4 -23.4 APOLLOTYRE-EQ EQ 100
    9 WC5758 NSE L&TFH EQ 1765.80 1794.60 28.80 18 18 99.70 98.10 98.25 28.8 28.8 28.8 L&TFH-EQ EQ
    10 WC5758 NSE ITC EQ 360.90 366.10 5.20 2 2 183.05 180.45 180.85 5.2 5.2 5.2 ITC-EQ EQ
    11 WC5758 NSE INFRATEL EQ 10988.00 11180.70 192.70 54 54 207.05 203.48 203.8 192.7 192.7 192.7 INFRATEL-EQ EQ
    12 WC5758 NSE DLF EQ 93069.00 94283.00 1214.00 486 486 194.00 191.50 190.3 1214 1214 1214 DLF-EQ EQ
    Worksheet: ap-Sheet1 6July

    If column I of 1.xls matches with column Z of ap.xls & column K of ap.xls is equals to column L of ap.xls Then
    Look column H of 1.xls & if column H of 1.xls is greater than column D of 1.xls then it has to copy the first row of OrderFormat.xlsx & paste it to BasketOrder.xlsx
    If column I of 1.xls matches with column Z of ap.xls & column K of ap.xls is equals to column L of ap.xls Then
    Look column H of 1.xls & if column H of 1.xls is lower than column D of 1.xls then it has to copy the third row of OrderFormat.xlsx & paste it to BasketOrder.xlsx


    _____ Workbook: OrderFormat.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 R S T U
    1 NSE EQ NA NA NA 0 0 BUY MARKET NA CLI MIS DAY WC5758 NA 3 NA
    2 NSE EQ NA NA NA 0 0 SELL SL-M CLI MIS DAY WC5758 NA NA NA
    3 NSE EQ NA NA NA 0 0 SELL MARKET NA CLI MIS DAY WC5758 NA 3 NA
    4 NSE EQ NA NA NA 0 0 BUY SL-M CLI MIS DAY WC5758 NA NA NA
    Worksheet: Sheet1

    Given BasketOrder
    _____ Workbook: BasketOrder.xlsx Given by Avinash ( Using Excel 2007 32 bit )
    Row\Col
    A
    B
    C
    D
    E
    F
    G
    H
    I
    J
    K
    L
    M
    N
    O
    P
    Q
    R
    S
    T
    U
    1
    NSE EQ NA NA NA
    0
    0
    BUY MARKET NA CLI MIS DAY WC5758 NA
    3
    NA
    Worksheet: Sheet1 6July

    For I of 25 in row 2 of 1.xls, we match with column z / row 3 in ap.xls
    Column K and column L in ap.xls are both = 2 in row 3 in ap.xls So column K of ap.xls is equals to column L of ap.xls
    Column H of row 2 in 1.xls is greater than column D of row 2 of 1.xls , so we copy the first row of of OrderFormat.xlsx & paste it to BasketOrder.xlsx
    So I assume / geuss the given workbook, BasketOrder.xlsx is for After
    ….If you are my competitor, I will try all I can to beat you. But if I do, I will not belittle you. I will Salute you, because without you, I am nothing.
    If you are my enemy, we will try to kick the fucking shit out of you…..
    Winston Churchill, 1939
    Save your Forum..._
    _...KILL A MODERATOR!!

  2. #272
    Fuhrer, Vierte Reich DocAElstein's Avatar
    Join Date
    Aug 2014
    Posts
    9,315
    Rep Power
    10
    Macro solution for this post:
    https://excelfox.com/forum/showthrea...ther-workbooks

    Code:
    '  https://excelfox.com/forum/showthread.php/2569-Copy-row-from-one-workbook-to-another-workbook-based-on-conditions-in-two-other-workbooks
    '   Copy row from one workbook to another workbook  based on conditions in two other workbooks
    Sub CopyRowFromWb4ToWb3basedOnConditionsInWb1AndWb2()
    Rem 1 worksheets range info
    Dim Wb1 As Workbook, Wb2 As Workbook, Wb3 As Workbook, Wb4 As Workbook
     Set Wb1 = Workbooks("1.xls")
     Set Wb2 = Workbooks("ap.xls")
     Set Wb3 = Workbooks("BasketOrder.xlsx")
     Set Wb4 = Workbooks("OrderFormat.xlsx")
    Dim Ws1 As Worksheet, Ws2 As Worksheet, Ws3 As Worksheet, Ws4 As Worksheet
     Set Ws1 = Wb1.Worksheets.Item(1)
     Set Ws2 = Wb2.Worksheets.Item(1)
     Set Ws3 = Wb3.Worksheets.Item(1)
     Set Ws4 = Wb4.Worksheets.Item(1)
    Dim Lr1 As Long, Lr2 As Long, Lr3 As Long ', Lr4 As Long
     Let Lr1 = Ws1.Range("A" & Ws1.Rows.Count & "").End(xlUp).Row
     Let Lr2 = Ws2.Range("D" & Ws2.Rows.Count & "").End(xlUp).Row
    Dim Rng1 As Range, Rng2 As Range ', Rng3 As Range, Rng4 As Range
     Set Rng1 = Ws1.Range("A1:I" & Lr1 & "")
     Set Rng2 = Ws2.Range("A1:Z" & Lr2 & "")
    '1b) data ranges for conditions
    Dim arr1() As Variant: Let arr1() = Rng1.Value2
    Dim arr1I() As Variant: Let arr1I() = Rng1.Columns(9).Value2
    Dim arr2() As Variant: Let arr2() = Rng2.Value2
    Dim arr2Z() As Variant: Let arr2Z() = Rng2.Columns("Z").Value2
    Rem 2 Do it
    Dim Cnt
        For Cnt = 2 To Lr1 Step 1
            If arr1I(Cnt, 1) <> "" Then
            Dim MtchRes As Variant
             Let MtchRes = Application.Match(arr1I(Cnt, 1), arr2Z(), 0)
                If IsError(MtchRes) Then
                ' column I 1.xls value is not in column Z of ap.xls
                Else '  column I of 1.xls matches with column Z of ap.xls
                    ' if column K of ap.xls is equals to column L of ap.xls
                    If arr2(MtchRes, 11) = arr2(MtchRes, 12) Then
                    ' If column H of 1.xls is greater than column D of 1.xls then
                        If arr1(Cnt, 8) > arr1(Cnt, 4) Then
                        'copy the first row of OrderFormat.xlsx & paste it to BasketOrder.xlsx
                         Let Ws3.Range("A1:U1").Value2 = Ws4.Range("A1:U1").Value2
                        ElseIf arr1(Cnt, 8) < arr1(Cnt, 4) Then ' If column H of 1.xls is less than column D of 1.xls then
                        'copy the third row of OrderFormat.xlsx & pate it to BasketOrder.xlsx
                        Else
                         Let Ws3.Range("A1:U1").Value2 = Ws4.Range("A3:U3").Value2
                        End If
                    Else
                    ' column K of ap.xls is not equal to column L of ap.xls
                    End If
                End If
            Else
            ' empty column I in 1.xls
            End If
        Next Cnt
    End Sub
    
    ….If you are my competitor, I will try all I can to beat you. But if I do, I will not belittle you. I will Salute you, because without you, I am nothing.
    If you are my enemy, we will try to kick the fucking shit out of you…..
    Winston Churchill, 1939
    Save your Forum..._
    _...KILL A MODERATOR!!

  3. #273
    Senior Member
    Join Date
    Jul 2019
    Posts
    382
    Rep Power
    0

    Appendix Thread. ( Codes for other Threads, ( Avinash ).)

    This was the Macro
    Code:
    Sub STEP3()
    Dim Wb1 As Workbook, Wb2 As Workbook
    Set Wb1 = Workbooks.Open("C:\Users\WolfieeeStyle\Desktop\1.xls")
    Set Wb2 = Workbooks.Open("C:\Users\WolfieeeStyle\Desktop\Hot Stocks\H2.xlsb")
    Dim Ws1 As Worksheet, Ws2 As Worksheet
    Set Ws1 = Wb1.Worksheets.Item(1)
    Set Ws2 = Wb2.Worksheets.Item(2)
    Dim Lr1 As Long, Lr2 As Long: 
    Let Lr1 = Ws1.Range("A" & Ws1.Rows.Count & "").End(xlUp).Row
    Let Lr2 = Ws1.Range("A" & Ws1.Rows.Count & "").End(xlUp).Row
    Dim rngSrch As Range: Set rngSrch = Ws2.Range("A2:A" & Lr2 & "")
    Dim rngDta As Range: Set rngDta = Ws1.Range("B2:B" & Lr1 & "")
    
    Dim Cnt As Long
        For Cnt = Lr2 To 1 Step -1
        Dim MtchedCel As Variant
         Set MtchedCel = rngSrch.Find(what:=rngDta.Item(Cnt), After:=rngSrch.Item(1), LookIn:=xlValues, LookAt:=xlWhole, SearchDirection:=xlNext, MatchCase:=True)
            If Not MtchedCel Is Nothing Then
             
            Else
            rngDta.Rows(Cnt).EntireRow.Delete Shift:=xlUp
            End If
            
        Next Cnt
     Wb1.Close SaveChanges:=True
     Wb2.Close SaveChanges:=True
    End Sub

    I changed this Macro As per my needs but getting error
    So Plz have a look Sir
    Code:
    Sub STEP6()
    Dim Wb1 As Workbook, Wb2 As Workbook
    Set Wb1 = Workbooks.Open("C:\Users\WolfieeeStyle\Desktop\1.xls")
    Set Wb2 = Workbooks.Open("C:\Users\WolfieeeStyle\Desktop\Hot Stocks\H2.xlsb")
    Dim Ws1 As Worksheet, Ws2 As Worksheet
    Set Ws1 = Wb1.Worksheets.Item(1)
    Set Ws2 = Wb2.Worksheets.Item(2)
    Dim Lr1 As Long, Lr2 As Long:
    Let Lr1 = Ws1.Range("A" & Ws1.Rows.Count & "").End(xlUp).Row
    Let Lr2 = Ws1.Range("A" & Ws1.Rows.Count & "").End(xlUp).Row
    Dim rngSrch As Range: Set rngSrch = Ws2.Range("A2:A" & Lr2 & "")
    Dim rngDta As Range: Set rngDta = Ws1.Range("B2:B" & Lr1 & "")
    
    Dim Cnt As Long
        For Cnt = Lr2 To 1 Step -1
        Dim MtchedCel As Variant
         Set MtchedCel = rngSrch.Find(what:=rngDta.Item(Cnt), After:=rngSrch.Item(1), LookIn:=xlValues, LookAt:=xlWhole, SearchDirection:=xlNext, MatchCase:=True)
            If Not MtchedCel Is Nothing Then
            rngDta.Rows(Cnt).EntireRow.Delete Shift:=xlUp
            Else
            
            End If
            
        Next Cnt
     Wb1.Close SaveChanges:=True
     Wb2.Close SaveChanges:=True
    End Sub

    Plz see the else statement in both the macros

    Error which i got, I uploaded the pic of the same




    https://eileenslounge.com/viewtopic....271392#p271392



    Plz run the macro the file which i have uploaded
    Attached Images Attached Images
    Attached Files Attached Files

  4. #274
    Fuhrer, Vierte Reich DocAElstein's Avatar
    Join Date
    Aug 2014
    Posts
    9,315
    Rep Power
    10
    Test post for later use, to get url now
    ….If you are my competitor, I will try all I can to beat you. But if I do, I will not belittle you. I will Salute you, because without you, I am nothing.
    If you are my enemy, we will try to kick the fucking shit out of you…..
    Winston Churchill, 1939
    Save your Forum..._
    _...KILL A MODERATOR!!

  5. #275
    Fuhrer, Vierte Reich DocAElstein's Avatar
    Join Date
    Aug 2014
    Posts
    9,315
    Rep Power
    10

    Text Files , Excel Files , Excel VBA Array

    In Avinash’s world are two types of files. Only two types , Text files and Excel files. There are no other types of file. There will probably never be any other types of files.



    All Files , text files, excel files and all other file types , are held in a computer as just a long string of Text. Even an Excel File is just a long piece of text inside a computer. But it is hard to understand. The software that is Excel decodes the long text and tries to make it appear in values and formats that we can see in a worksheet





    Excel Files ( Excel Worksheet spreadsheet )
    .xls .xlsm .xlsx .xlsb
    An Excel file is very complicated. It can have values and lots of cell formatting.
    Because of all cell formatting, it can be very slow in working. Excel is not an efficient thing to use if you only have values

    We can open an Excel File manually, using Excel or Notepad
    ExcelFileOpenInNotepad.JPG : https://imgur.com/bdym9Lc ExcelFileOpenInExcel.JPG : https://imgur.com/gwOtksS
    06_ExcelFileInNotepad.jpg03_ExcelFileOpenInExcel.JPG
    In Excel it may looks like this
    ExcelFile.JPG : https://imgur.com/8xaZihR
    07_ExcelFile.JPG
    _____ Workbook: ExcelFile.xlsx ( Using Excel 2007 32 bit )
    Row\Col A B C
    1 A B
    2 C D
    3
    Worksheet: Sheet1

    In Notepad it looks like this:
    ExcelFileInNotepad.JPG : https://imgur.com/wHTPbO6
    05_ExcelFileOpenInNotepad.jpg
    Code:
     PK          ! U6»+w   (     Ø [Content_Types].xml ¢Ô (                                                                                                                                                                                                                                                                                                                                                                                                                                                                                   ÌTËNÃ0 ¼#ñ ‘¯(q[ B¨i <ŽP	ø co «ŽmyÝÒþ=›¤* Ѩ¥=pI %;3žÌp¼¬L²€€ÚÙœõ³ KÀJ§´æìíõ1½a	Fa•0ÎBÎV€l<:? ¾®<`BÓ sVÆèo9GYB%0s ,½)\¨D¤Ç0å^È™˜ -ôz×\: ÁÆ4Ö l4|& A+H&"Ä'Q  _  	 Úk?#<–ܵƒ5w΄÷FK I9_Xõƒ5uE¡%('ç qe ØEÂw b\ À£©Ð 
    K€X™¬ Ý0ßC!æ&& Kr 5=€ÁÃŽ¶63£ÉæøXj  
    ÝÞu{òáÂìݹ٩]©ÝÉ*¡íF÷Ž Ôü•È›ÛÕ‰…lñ»tPŠ&Áy䔹£ù¡^½ •z‚„ 5lw•§ƒ£5|è^ Ð ¹ýn½‹Ë¢ãøvø›¬XŠ ê% jË“×ÆWì½²)]€Ã ²é’zú—Dò¦çGŸ   ÿÿ  PK          ! µU0#õ   L   
     Î _rels/.rels ¢Ê (
    That text above of a simple Excel File is very complicated because it has all the information needed by Excel to make all the cells and formatting

    Making an Excel File with Excel VBA
    We can make that Excel File using Excel VBA
    Code:
    Sub MakeExcelFile()
    Dim Wb As Workbook, Ws As Worksheet
     Workbooks.Add
     Set Wb = ActiveWorkbook
     Set Ws = Wb.Worksheets.Item(1)
     Let Ws.Range("A1") = "A": Let Ws.Range("B1") = "B"
     Let Ws.Range("A2") = "C": Let Ws.Range("B2") = "D"
     Wb.SaveAs Filename:=ThisWorkbook.Path & "\ExcelFile.xlsx"
    End Sub

    We usually open Excel files with Excel. So that is why the files with the extensions of .xls .xlsm .xlsx .xlsb are called Excel Files. Such files were designed to be opened in Excel

    If we are using an Excel file to store simple data values, then the values are usually divided up so that when opened in Excel the data is shown in cells in rows and columns




    Text Files
    .csv .txt
    Text files are very simple. They only have values and sometimes , if it is being used to store data values, it may have separators**. ( Sometimes we call the seperators delimiters ).

    A B
    C D

    A,B
    C,D


    We usually open text files with a text editor. For example Notepad.
    TextFileOpenInNotepad.JPG : https://imgur.com/zzRAVIN
    02_TextFileOpenInNotepad.jpg
    Because Text files are not complicated, we can see them easily in Notepad. Because we sometimes open files with the extension of .csv .txt in Notepad , they may be called Notepad files, and sometimes files with the extension of .csv may be called a comma separated values text values file or “csv file”. But really they are both Text files

    **If we want to store simple data values in a text file, then we have the problem that we have no way to make the data appear in cells, because a text file has no cell information and also no other formatting information.
    So we typically separate data on a line with something like, _ ; , vbTab | _ etc…
    A Line is separated from the next line by an “invisible” character which tells a computer to make a new line, for example
    vbCr & vbLf

    Make a Text file using Excel VBA
    We can make a text file using Excel VBA
    Code:
    Sub MakeTextFile()
    Dim FileNum As Long: Let FileNum = FreeFile(1)                        ' https://msdn.microsoft.com/en-us/vba/language-reference-vba/articles/freefile-function
     Open ThisWorkbook.Path & "\" & "TextFile.txt" For Output As #FileNum ' Will be made if not there
     Print #FileNum, "A" & vbTab & "B" & vbCr & vbLf & "C" & vbTab & "D"
     Close #FileNum
    End Sub
    We can try to .Open a text file in Excel. Excel will try to show us the values from it in cells. It may work. It may not work. There will always be problems.
    But we may want to see the values in Excel
    Because there are always problems .Opening a text file in Excel, we import the values into an Excel worksheet instead
    The text file made in that last macro , TextFile.txt , can be seen in Notepad to look like this:
    TextFile_txtInNotepad.JPG : https://imgur.com/0B2BQpK
    Code:
    A	B
    C	D
    ( We can represent that file as a simple string in VBA coding, thus:
    "A" & vbTab & "B" & vbCr & vbLf & "C" & vbTab & "D"
    ( We might sometimes call this a Tab separated values or Tab delimited values text file ) )
    The following macro is the best way to put the values from that text file into a worksheet. This may typically be called importing a text file into Excel. It does not convert a text file to an Excel File.
    Code:
    Sub ImportTextFileValuesIntoExcelWorksheet()
    Rem 1 Add a workbook to display the values from a Tab delimited values  text file
    Dim Wb As Workbook, Ws As Worksheet
     Workbooks.Add
     Set Wb = ActiveWorkbook
     Set Ws = Wb.Worksheets.Item(1)
    
    Rem 2 Put the entire text file into a single string,  TotalFile
    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 & "\" & "TextFile.txt" '
    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 hs to be a string of exactly the right length
    Get #FileNum, , TotalFile
    Close #FileNum                                                                 ' I need to do this, or there may be problems with my computer as I have an open route which may interact badly with something else
        
        If Right(TotalFile, 2) = vbCr & vbLf Then Let TotalFile = Left(TotalFile, Len(TotalFile) - 2) '  Sometimes an extra line seperator gets added, so I remove it if that is the case
    
    Rem 3 Loop through the lines of the text file and paste each line to a row in the worksheet
    Dim Rws() As String                                                            ' I want to get an array of all my rows
     Let Rws() = Split(TotalFile, vbCr & vbLf, -1, vbBinaryCompare)                ' I  Split  by the row seperator which is usualy  vbCr & vbLf   but note that it might sometimes be something else
    Dim Cnt As Long                                                                ' I wat to loop for all the lines in the text file
        For Cnt = 1 To UBound(Rws()) + 1                                           ' I need to use +1 because the one dimensional array returned by  Split  starts at 0
        Dim Clms() As String                                                       ' I want an array of just the values. I can easily achieve this by spliting by the value seperator
         Let Clms() = Split(Rws(Cnt - 1), vbTab, -1, vbBinaryCompare)              ' I now split the row into columns using the value seperator, which in this case is  vbTab
         Let Ws.Range("A" & Cnt & "").Resize(1, UBound(Clms()) + 1).Value = Clms() ' I can assign my 1 dimensional array to a worksheet range, and Excel will accept it conventionally as a row of data
        Next Cnt
     End Sub
    It is better to use text files and manipulate text files with Excel VBA if we are only looking at values




    VBA Arrays
    It is better to use text files and manipulate text files with Excel VBA if we are only looking at values.
    Excel is very slow and inefficient if we are only looking at values
    But we can make Macros for Excel using Excel VBA a little better if we use VBA arrays.
    Instead of putting values in an Excel worksheet, one value at a time, we can put all values into an array, and then at the end of the macro we can put all the values into the worksheet in one go. This makes the macro quicker
    Code:
    Sub MakeExcelFileUsingVBAArrays()
    Dim Wb As Workbook, Ws As Worksheet
     Workbooks.Add
     Set Wb = ActiveWorkbook
     Set Ws = Wb.Worksheets.Item(1)
    ' Make array
    Dim arr1(1 To 2, 1 To 2) As String
     Let arr1(1, 1) = "A": Let arr1(1, 2) = "B"
     Let arr1(2, 1) = "C": Let arr1(2, 2) = "D"
    ' Paste entire array into worksheet in one go
     Let Ws.Range("A1:B2").Value = arr1()
     
     Wb.SaveAs Filename:=ThisWorkbook.Path & "\ExcelFileMadeUsingVBAArrays.xlsx"
    End Sub
    
    The array, arr1() , can be considered to look like this:
    1
    2
    1
    A
    B
    2
    C
    D

    But we cannot easily see this array, as it is just inside the computer in memory. But we can paste the array into a worksheet in one go using a code line like:
    Let1 Ws.Range("A1:B2").Value = arr1()




    For Avinash it is better to use as much manipulation of text files using VBA and VBA arrays as possible

    You must not learn any VBA coding if you do not want to.
    But you must try to understand the difference in text files and excel files
    If you cannot or will not learn this, then there is no point in anyone trying to help you further. You will get nowhere. You will waste everybody’s time, including your own
    Last edited by DocAElstein; 07-20-2020 at 02:52 PM.
    ….If you are my competitor, I will try all I can to beat you. But if I do, I will not belittle you. I will Salute you, because without you, I am nothing.
    If you are my enemy, we will try to kick the fucking shit out of you…..
    Winston Churchill, 1939
    Save your Forum..._
    _...KILL A MODERATOR!!

  6. #276
    Fuhrer, Vierte Reich DocAElstein's Avatar
    Join Date
    Aug 2014
    Posts
    9,315
    Rep Power
    10
    posting to get the URL for later use
    ….If you are my competitor, I will try all I can to beat you. But if I do, I will not belittle you. I will Salute you, because without you, I am nothing.
    If you are my enemy, we will try to kick the fucking shit out of you…..
    Winston Churchill, 1939
    Save your Forum..._
    _...KILL A MODERATOR!!

  7. #277
    Fuhrer, Vierte Reich DocAElstein's Avatar
    Join Date
    Aug 2014
    Posts
    9,315
    Rep Power
    10
    Next macro version to answer this Thread Post:
    https://excelfox.com/forum/showthrea...ll=1#post14635


    Code:
    Sub STEP3b() '  https://excelfox.com/forum/showthread.php/2364-Delete-rows-based-on-match-criteria-in-two-excel-files?p=14587&viewfull=1#post14587    https://eileenslounge.com/viewtopic.php?f=30&t=34937
    Dim Wb1 As Workbook, Wb2 As Workbook
    Set Wb1 = Workbooks.Open(ThisWorkbook.Path & "\1(sample).xls")                ' Workbooks.Open("C:\Users\WolfieeeStyle\Desktop\1.xls")
    Set Wb2 = Workbooks.Open(ThisWorkbook.Path & "\H2(SAMPLE).xlsx") ' Workbooks.Open("C:\Users\WolfieeeStyle\Desktop\Hot Stocks\H2.xlsb")
    Dim Ws1 As Worksheet, Ws2 As Worksheet
    Set Ws1 = Wb1.Worksheets.Item(1)                                   ' First worksheet tab counting from the left
    Set Ws2 = Wb2.Worksheets.Item(2)                                   ' Second worksheet tab cunting from the left
    Dim Lr1 As Long, Lr2 As Long
    Let Lr1 = Ws1.Range("A" & Ws1.Rows.Count & "").End(xlUp).Row       ' Dynamically getting the last row in worksheet referenced by  Ws1
    Let Lr2 = Ws2.Range("A" & Ws2.Rows.Count & "").End(xlUp).Row       ' Dynamically getting the last row in worksheet referenced by  Ws2
    Dim rngSrch As Range: Set rngSrch = Ws2.Range("A2:A" & Lr2 & "")   ' The range that will be searched in
    Dim rngDta As Range: Set rngDta = Ws1.Range("B1:B" & Lr1 & "")     ' The range from which data will be looked for in rngSrch
    
    Dim Cnt As Long  '    For  each  rngDta.Item(Cnt)
        For Cnt = Lr1 To 2 Step -1                                     ' We take  -ve  steps = we go backwards. This is important when deleteing things.  See: https://excelfox.com/forum/showthread.php/2345-Appendix-Thread-(-Codes-for-other-Threads-HTML-Tables-etc-)?p=12902&viewfull=1#post12902
        Dim MtchedCel As Variant
         Set MtchedCel = rngSrch.Find(what:=rngDta.Item(Cnt), After:=rngSrch.Item(1), LookIn:=xlValues, LookAt:=xlWhole, SearchDirection:=xlNext, MatchCase:=True)
            If Not MtchedCel Is Nothing Then ' Range.Find  would return nothing if it did not find a match
                  ' If it was  Not  Nothing  then there was a match. So we do nothing
            Else  ' The attempt at a match failed, we got  Nothing  this is the condition to delete
             rngDta.Rows(Cnt).EntireRow.Delete Shift:=xlUp             ' The row is deleted , and so we have a space which is filled by shifting all rows in the worksheet  Up
            End If
            
        Next Cnt             ' Next  rngDta.Item(Cnt)
     Wb1.Close SaveChanges:=True                                       ' Save the file and close it
     Wb2.Close SaveChanges:=True                                       ' Save the file and close it
    End Sub





    So finally what this macro is doing. In English:
    Data values in Ws1 , (first worksheet in "1(sample).xls") column B , are looked for ( attempted to be matched ) to the column A range in Ws2 ( second worksheet in "H2(SAMPLE).xlsx")
    If a match is found, then nothing is done. If a match was not found, then the entire row containing the data value in Ws1 is deleted
    Last edited by DocAElstein; 07-18-2020 at 12:39 AM.
    ….If you are my competitor, I will try all I can to beat you. But if I do, I will not belittle you. I will Salute you, because without you, I am nothing.
    If you are my enemy, we will try to kick the fucking shit out of you…..
    Winston Churchill, 1939
    Save your Forum..._
    _...KILL A MODERATOR!!

  8. #278
    Fuhrer, Vierte Reich DocAElstein's Avatar
    Join Date
    Aug 2014
    Posts
    9,315
    Rep Power
    10
    Macros for this Post
    https://excelfox.com/forum/showthrea...ll=1#post14639


    Data values in Ws1 , (first worksheet in "1(sample).xls") column B , are looked for ( attempted to be matched ) to the column A range in Ws2 ( second worksheet in "H2(SAMPLE).xlsx")
    If a match is not found, then nothing is done. If a match is found, then the entire row containing the data value in Ws1 is deleted


    Code:
    Sub STEP3c() '  https://excelfox.com/forum/showthread.php/2364-Delete-rows-based-on-match-criteria-in-two-excel-files?p=14639&viewfull=1#post14639
    Dim Wb1 As Workbook, Wb2 As Workbook
    Set Wb1 = Workbooks.Open(ThisWorkbook.Path & "\1(sample).xls")                ' Workbooks.Open("C:\Users\WolfieeeStyle\Desktop\1.xls")
    Set Wb2 = Workbooks.Open(ThisWorkbook.Path & "\H2SAMPLE.xlsx") ' Workbooks.Open("C:\Users\WolfieeeStyle\Desktop\Hot Stocks\H2.xlsb")
    Dim Ws1 As Worksheet, Ws2 As Worksheet
    Set Ws1 = Wb1.Worksheets.Item(1)                                   ' First worksheet tab counting from the left
    Set Ws2 = Wb2.Worksheets.Item(2)                                   ' Second worksheet tab counting from the left
    Dim Lr1 As Long, Lr2 As Long
    Let Lr1 = Ws1.Range("B" & Ws1.Rows.Count & "").End(xlUp).Row       ' Dynamically getting the last row in worksheet referenced by  Ws1
    Let Lr2 = Ws2.Range("A" & Ws2.Rows.Count & "").End(xlUp).Row       ' Dynamically getting the last row in worksheet referenced by  Ws2
    Dim rngSrch As Range: Set rngSrch = Ws2.Range("A1:A" & Lr2 & "")   ' The range that will be searched in
    Dim rngDta As Range: Set rngDta = Ws1.Range("B1:B" & Lr1 & "")     ' The range from which data will be looked for in rngSrch
    
    Dim Cnt As Long  '    For  each  rngDta.Item(Cnt)
        For Cnt = Lr1 To 2 Step -1                                     ' We take  -ve  steps = we go backwards. This is important when deleteing things.  See: https://excelfox.com/forum/showthread.php/2345-Appendix-Thread-(-Codes-for-other-Threads-HTML-Tables-etc-)?p=12902&viewfull=1#post12902
        Dim MtchedCel As Variant
         Set MtchedCel = rngSrch.Find(what:=rngDta.Item(Cnt), After:=rngSrch.Item(1), LookIn:=xlValues, LookAt:=xlWhole, SearchDirection:=xlNext, MatchCase:=True)
            If Not MtchedCel Is Nothing Then ' Range.Find  would return nothing if it did not find a match.  Not  Nothing is the condituion of a match, the condition to delete the row
             rngDta.Rows(Cnt).EntireRow.Delete Shift:=xlUp             ' The row is deleted , and so we have a space which is filled by shifting all rows in the worksheet  Up
            Else  ' The attempt at a match failed, we got  Nothing  this is the condition to do nothing
            ' If it was   Nothing  then there was not a match. So we do nothing
            End If
        Next Cnt             ' Next  rngDta.Item(Cnt)
     Wb1.Close SaveChanges:=True                                       ' Save the file and close it
     Wb2.Close SaveChanges:=True                                       ' Save the file and close it
    End Sub

    Or


    Code:
    Sub STEP3d() ' https://excelfox.com/forum/showthread.php/2364-Delete-rows-based-on-match-criteria-in-two-excel-files?p=14639&viewfull=1#post14639  https://excelfox.com/forum/showthread.php/2364-Delete-rows-based-on-match-criteria-in-two-excel-files?p=14639&viewfull=1#post14639
    Dim Wb1 As Workbook, Wb2 As Workbook
    Set Wb1 = Workbooks.Open(ThisWorkbook.Path & "\1(sample).xls")                ' Workbooks.Open("C:\Users\WolfieeeStyle\Desktop\1.xls")
    Set Wb2 = Workbooks.Open(ThisWorkbook.Path & "\H2SAMPLE.xlsx") ' Workbooks.Open("C:\Users\WolfieeeStyle\Desktop\Hot Stocks\H2.xlsb")
    Dim Ws1 As Worksheet, Ws2 As Worksheet
    Set Ws1 = Wb1.Worksheets.Item(1)                                   ' First worksheet tab counting from the left
    Set Ws2 = Wb2.Worksheets.Item(2)                                   ' Second worksheet tab cunting from the left
    Dim Lr1 As Long, Lr2 As Long
    Let Lr1 = Ws1.Range("B" & Ws1.Rows.Count & "").End(xlUp).Row       ' Dynamically getting the last row in worksheet referenced by  Ws1
    Let Lr2 = Ws2.Range("A" & Ws2.Rows.Count & "").End(xlUp).Row       ' Dynamically getting the last row in worksheet referenced by  Ws2
    Dim rngSrch As Range: Set rngSrch = Ws2.Range("A1:A" & Lr2 & "")   ' The range that will be searched in
    Dim rngDta As Range: Set rngDta = Ws1.Range("B1:B" & Lr1 & "")     ' The range from which data will be looked for in rngSrch
    
    Dim Cnt As Long  '    For  each  rngDta.Item(Cnt)
        For Cnt = Lr1 To 2 Step -1                                     ' We take  -ve  steps = we go backwards. This is important when deleteing things.  See: https://excelfox.com/forum/showthread.php/2345-Appendix-Thread-(-Codes-for-other-Threads-HTML-Tables-etc-)?p=12902&viewfull=1#post12902
        Dim MtchedCel As Variant
         Set MtchedCel = rngSrch.Find(what:=rngDta.Item(Cnt), After:=rngSrch.Item(1), LookIn:=xlValues, LookAt:=xlWhole, SearchDirection:=xlNext, MatchCase:=True)
            If MtchedCel Is Nothing Then  ' Range.Find  would return nothing if it did not find a match.    Nothing is the condituion of no match, the condition to do nothing
             ' If a match is not found, then nothing is done
            Else  ' The attempt at a match was succesful, we got  a match, the condition to delete the row
             rngDta.Rows(Cnt).EntireRow.Delete Shift:=xlUp             ' The row is deleted , and so we have a space which is filled by shifting all rows in the worksheet  Up
            End If
        Next Cnt             ' Next  rngDta.Item(Cnt)
     Wb1.Close SaveChanges:=True                                       ' Save the file and close it
     Wb2.Close SaveChanges:=True                                       ' Save the file and close it
    End Sub
    
    ….If you are my competitor, I will try all I can to beat you. But if I do, I will not belittle you. I will Salute you, because without you, I am nothing.
    If you are my enemy, we will try to kick the fucking shit out of you…..
    Winston Churchill, 1939
    Save your Forum..._
    _...KILL A MODERATOR!!

  9. #279
    Fuhrer, Vierte Reich DocAElstein's Avatar
    Join Date
    Aug 2014
    Posts
    9,315
    Rep Power
    10
    Macro solution for Problem 2 ( Problem2a )

    I am using vba arrays because for your values work that is the best approach in Excel ( https://excelfox.com/forum/showthrea...ll=1#post14628 )
    I do not delete rows, so I do no backward looping
    Instead I collect indices of the rows I want to have = rows which are not deleted. For you test data, the rows I want are 1 4 5 6 7 8 9 ( rows 2 and 3 ) are not wanted
    Attached Files Attached Files
    Last edited by DocAElstein; 07-18-2020 at 03:14 PM. Reason: Correction Set WbDEF = Workbooks.Open(ThisWorkbook.path & "\DEF PROBLEM 2.xlsx")
    ….If you are my competitor, I will try all I can to beat you. But if I do, I will not belittle you. I will Salute you, because without you, I am nothing.
    If you are my enemy, we will try to kick the fucking shit out of you…..
    Winston Churchill, 1939
    Save your Forum..._
    _...KILL A MODERATOR!!

  10. #280
    Fuhrer, Vierte Reich DocAElstein's Avatar
    Join Date
    Aug 2014
    Posts
    9,315
    Rep Power
    10
    Macro solution for Problem 2 ( Problem2b ) - Problem 2 https://excelfox.com/forum/showthrea...ll=1#post14648

    This is a conventional solution Problem2b like the ones you have seen a lot of in the last few days. It deletes the rows ( rows 2 and 3 )



    Code:
    ' https://excelfox.com/forum/showthread.php/2577-Appendix-Thread-(-Codes-for-other-Threads-(-Avinash-)-)?p=14646&viewfull=1#post14646
    ' Problem 2b conventional '    https://excelfox.com/forum/showthread.php/2582-delete-entire-row-by-vbA
    Sub DeleteRows()
    Rem 1 Worksheets data info
    Dim WbABC As Workbook, WsABC As Worksheet
     Set WbABC = Workbooks.Open(ThisWorkbook.path & "\ABC.xls")
     Set WsABC = WbABC.Worksheets.Item(1)
    Dim WbDEF As Workbook, WsDEF As Worksheet
     Set WbDEF = Workbooks.Open(ThisWorkbook.path & "\DEF PROBLEM 2.xlsx")
     Set WsDEF = WbABC.Worksheets.Item(1)
    Dim LrABC As Long, LrDEF As Long
     Let LrABC = WsABC.Range("A" & WsABC.Rows.Count & "").End(xlUp).Row       ' Dynamically getting the last row in worksheet referenced by  WsABC
     Let LrDEF = WsDEF.Range("B" & WsDEF.Rows.Count & "").End(xlUp).Row       ' Dynamically getting the last row in worksheet referenced by  WsDEF
    Dim rngSrch As Range
     Set rngSrch = WsDEF.Range("B1:B" & LrDEF & "")
    Dim arrDta() As Variant
     Let arrDta() = WsABC.Range("I1:I" & LrABC & "").Value2
    Rem 2 Do it
    Dim Cnt
        For Cnt = LrABC To 2 Step -1
        Dim MtchedCel As Variant
         Set MtchedCel = rngSrch.Find(what:=arrDta(Cnt, 1), After:=rngSrch.Item(1), LookIn:=xlValues, LookAt:=xlWhole, SearchDirection:=xlNext, MatchCase:=True)
            If Not MtchedCel Is Nothing Then                                  ' Range.Find  would return nothing if it did not find a match
             ' If it was  Not  Nothing  then there was a match = condition to delete
             WsABC.Rows(Cnt).EntireRow.Delete Shift:=xlUp             ' The row is deleted , and so we have a space which is filled by shifting all rows in the worksheet  Up
            Else ' MtchedCel  is  Nothing
             ' The attempt at a match failed, we got  Nothing  this is the condition to do nothing
            End If
        Next Cnt
    Rem Close save workbooks
     WbABC.Close Savechanges:=True                                    ' Save the file and close it
     WbDEF.Close                                                      ' Close file. No changes were made
    End Sub
    
    Last edited by DocAElstein; 07-18-2020 at 04:07 PM. Reason: Corrction Set WbDEF = Workbooks.Open(ThisWorkbook.path & "\DEF PROBLEM 2.xlsx")
    ….If you are my competitor, I will try all I can to beat you. But if I do, I will not belittle you. I will Salute you, because without you, I am nothing.
    If you are my enemy, we will try to kick the fucking shit out of you…..
    Winston Churchill, 1939
    Save your Forum..._
    _...KILL A MODERATOR!!

Similar Threads

  1. Replies: 184
    Last Post: 03-16-2024, 01:16 PM
  2. Tests and Notes for EMail Threads
    By DocAElstein in forum Test Area
    Replies: 29
    Last Post: 11-15-2022, 04:39 PM
  3. Replies: 379
    Last Post: 11-13-2020, 07:44 PM
  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
  •