Page 3 of 3 FirstFirst 123
Results 21 to 29 of 29

Thread: copy and paste by VBA based on criteria

  1. #21
    Senior Member
    Join Date
    Jul 2019
    Posts
    382
    Rep Power
    0
    Thnx Alan Elston Sir (Doc Sir)

  2. #22
    Senior Member
    Join Date
    Jul 2019
    Posts
    382
    Rep Power
    0

    copy and paste by vba

    vba is placed in a seperate file macro.xlsm
    there are two files 1.xlsx & 2.xlsx
    all files are located in a different place
    2.xlsx file is blank file it doesn't have any data
    in 1.xlsx i have data (i have attached the sample pic of the same)
    now what i want is see the yellow highlighted colour data and if yellow highlighted colour data is greater than 5 or equal to 5 then copy the stock name and paste it to 2.xlsx
    i have attached the sample pic of the result it will be pasted to 2.xlsx from 1.xlsx
    so plz have a look sir and help me out in solving this problem sir
    Attached Images Attached Images

  3. #23
    Fuhrer, Vierte Reich DocAElstein's Avatar
    Join Date
    Aug 2014
    Posts
    9,313
    Rep Power
    10
    Hi
    There are very many different ways to do something like this.
    So this solution would be just one of many ways.

    Example:

    Before:

    _____ Workbook: 1.xlsx ( Using Excel 2007 32 bit )
    Row\Col
    A
    B
    C
    D
    E
    F
    G
    H
    I
    J
    K
    L
    M
    1
    Stock Name Data Data Data Data Data Data Data Data Data Data Data Data
    2
    ACC
    800
    700
    600
    500
    400
    300
    200
    100
    90
    80
    70
    3
    ADANIENT
    800
    700
    600
    500
    400
    300
    200
    100
    90
    80
    70
    4
    ADANIPORTS
    800
    700
    600
    500
    400
    300
    200
    100
    90
    80
    70
    5
    ADANIPOWER
    800
    700
    600
    500
    400
    3
    200
    100
    90
    80
    70
    6
    AMARAJABAT
    800
    700
    600
    500
    400
    300
    200
    100
    90
    80
    70
    7
    AMBUJACEM
    800
    700
    600
    500
    400
    300
    200
    100
    90
    80
    70
    8
    ONGC
    800
    700
    600
    500
    400
    300
    200
    100
    90
    80
    70
    9
    Worksheet: Sheet1 (2)

    run macro here: http://www.excelfox.com/forum/showth...ll=1#post13059

    Output results After running macro

    _____ Workbook: 2.xlsx ( Using Excel 2007 32 bit )
    Row\Col
    A
    B
    C
    1
    ACC 500
    2
    ADANIENT 700
    3
    AMARAJABAT 400
    4
    Worksheet: Tabelle2



    macro is here : https://imgur.com/Rs0EaVf , and also in uploaded file.
    Attachment 2838
    Attached Images Attached Images
    Attached Files Attached Files
    ….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!!

  4. #24
    Senior Member
    Join Date
    Jul 2019
    Posts
    382
    Rep Power
    0
    Thnx Alot Doc Sir for helping me in solving this problem

  5. #25
    Senior Member
    Join Date
    Jul 2019
    Posts
    382
    Rep Power
    0

    Copy and paste the data if condition met

    All files are located in different path
    vba will be placed in a macro.xlsm
    i have a file name 1.xls & 2.xls
    match column I of 1.xls with column B of 2.xls
    If column I of 1.xls matches with column B of 2.xls then do nothing &
    if column I of 1.xls doesnt matches with column B of 2.xls then copy and paste the column B & Column I of 1.xls to column A & column B of sheet2 of 2.xls
    sheet name can be anything
    plz see the sample pic & help me in solving this problem by vba

    the bigger pic is 1.xls
    the smallest pic is sheet2 of 2.xls (result)




    Moderator notice...
    Yet again another cross post
    https://www.excelguru.ca/forums/show...-condition-met
    Attached Images Attached Images

  6. #26
    Fuhrer, Vierte Reich DocAElstein's Avatar
    Join Date
    Aug 2014
    Posts
    9,313
    Rep Power
    10
    I think you have not explained correctly what you want.
    Your question explanation does not match you sample data.
    Once again you have incorrectly explained what you want.

    This is wrong!!!
    If column I of 1.xls matches with column B of 2.xls then do nothing &
    if column I of 1.xls doesnt matches with column B of 2.xls then copy and paste the column B & Column I of 1.xls to column A & column B of sheet2 of 2.xls

    It is rubbish. It does not explain your test data.

    Once again I must try to guess what you want!

    This is my guess:
    Consider the value in each row of column I of 1.xls, starting from row 2
    If the value from that row of column I of 1.xls is also in any row of column B of the first worksheet in 2.xls , then
    do nothing.
    Else If the value from that row of column I of 1.xls is not to be found in any row of column B of the first worksheet in 2.xls, then do the following:
    Copy the value from columns B and I for that row of 1.xls and paste them to columns A and B of the second worksheet of 2.xls

    Before:
    _____ Workbook: 2.xls ( Using Excel 2007 32 bit )
    Row\Col
    A
    B
    1
    Exchange
    2
    NSE 25
    3
    NSE 10583
    4
    NSE 17388
    5
    NSE 100
    Worksheet: Sheet1 (2)
    _____ Workbook: 2.xls ( Using Excel 2007 32 bit )
    Row\Col
    A
    B
    C
    1
    2
    3
    Worksheet: Sheet2

    _____ 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
    1087
    1030
    955.5
    998.45
    1079.9
    25
    3
    NSE ACC EQ
    148.05
    27.75
    25.65
    25.65
    146.5
    22
    4
    NSE DLF EQ
    265
    419.7
    350.05
    387.25
    267.15
    10583
    5
    NSE AMBUJACEM EQ
    30.4
    155.8
    142.55
    145.85
    29.95
    17388
    6
    NSE AMARAJABAT EQ
    502
    514.85
    502
    499.05
    507.45
    100
    Worksheet: 1-Sheet1

    After results
    _____ Workbook: 2.xls ( Using Excel 2007 32 bit )
    Row\Col
    A
    B
    C
    1
    ACC
    22
    2
    Worksheet: Sheet2

    Macro:
    Code:
    Sub Step11() '    http://www.excelfox.com/forum/showthread.php/2421-copy-and-paste-by-VBA-based-on-criteria?p=13110&viewfull=1#post13110      http://www.excelfox.com/forum/showthread.php/2458-Copy-and-paste-the-data-if-condition-met
    Rem 1 Worksheets info
    Dim Wb1 As Workbook, Wb2 As Workbook   '                           If the workbook is already open , then we can refer to it using the workbooks collection object of open workbooks,  Workbooks(" ")
     Set Wb1 = Workbooks("1.xls")         ' Workbooks("1.xlsx")         '          Workbooks("sample1.xlsx")   '                                                 Set Wb1 = Workbooks.Open(ThisWorkbook.Path & "\1.xls")                ' w1 = Workbooks.Open("C:\Users\WolfieeeStyle\Desktop\1.xls")           ' change the file path   If the workbook is already open , then we can refer to it using the workbooks collection object of open workbooks,  Workbooks(" ")
     Set Wb2 = Workbooks("2.xls")         ' Workbooks("2.xlsx")         '          Workbooks("sample2.xlsx")   '                                                 Set Wb2 = Workbooks.Open(ThisWorkbook.Path & "\FundsCheck.xlsb")      ' w2 = Workbooks.Open("C:\Users\WolfieeeStyle\Desktop\FundsCheck.xlsb") ' change the file path      If the workbook is already open , then we can refer to it using the workbooks collection object of open workbooks,  Workbooks(" ")
    Dim Ws1 As Worksheet, Ws2 As Worksheet, Ws22 As Worksheet
     Set Ws1 = Wb1.Worksheets.Item(1)      '                                                                            Set Ws1 = Wb1.Worksheets("anything")  '     sheet name can be anything
     Set Ws2 = Wb2.Worksheets.Item(1)      '                                                                          ' Set Ws2 = Wb2.Worksheets("anything")
     Set Ws22 = Wb2.Worksheets.Item(2)
    Dim Lr1 As Long, Lr2 As Long, Lr As Long, Lr22 As Long
     Let Lr1 = Ws1.Range("A" & Ws1.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. )
     Let Lr2 = Ws2.Range("A" & Ws1.Rows.Count).End(xlUp).Row
    ' Let Lr = IIf(Lr2 > Lr1, Lr2, Lr1)
    Rem 2 do it
    Dim cnt
        For cnt = 2 To Lr2
        Dim VarMtch As Variant
         Let VarMtch = Application.Match(CStr(Ws1.Range("I" & cnt & "").Value), Ws2.Range("B2:B" & Lr2 & ""), 0) ' We look for the string value from each row in column I of Ws1 in the range of column B in Ws2
            If Not IsError(VarMtch) Then ' If we have a match, then  Application.Match  will return an integer of the position along(down) where the match is found
            ' do nothing
            Else '  Application.Match  will return a VB error string if no match could be found
             Ws1.Range("B" & cnt & ",I" & cnt & "").Copy  ' if ranges are "in line" - that is to say have the same "width" ( in this example a single row width ) , then VBA lets us copy this to the clipboard
             Let Lr22 = Lr22 + 1 ' next free row in second worksheet of 2.xls
             Ws22.Range("A" & Lr22 & "").PasteSpecial Paste:=xlPasteValues ' Pasting of copied values which were "in line" allows us to paste out, but the missing in between bits ( columns in this example ) are missed out - the ranges are put together. Co incidentally we want this output in this example
            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!!

  7. #27
    Senior Member
    Join Date
    Jul 2019
    Posts
    382
    Rep Power
    0
    Minor changes are there in this post
    Code:
    Sub STEP9()
    Dim Wb1 As Workbook, Wb2 As Workbook, Wb3 As Workbook
     Set Wb1 = Workbooks.Open("C:\Users\WolfieeeStyle\Desktop\1.xls")
     Set Wb2 = Workbooks.Open("C:\Users\WolfieeeStyle\Desktop\Alert..csv")
     Set Wb3 = Workbooks.Open("C:\Users\WolfieeeStyle\Desktop\Files\AlertCodes.xlsx")
    
    Dim Ws1 As Worksheet, Ws2 As Worksheet, Ws3 As Worksheet
     Set Ws1 = Wb1.Worksheets.Item(1)
     Set Ws2 = Wb2.Worksheets.Item(1)
     Set Ws3 = Wb3.Worksheets.Item(2)
    Dim Lr1 As Long, Lr2 As Long, Lr As Long, Lr3 As Long
     Let Lr1 = Ws1.Range("A" & Ws1.Rows.Count).End(xlUp).Row
     Let Lr2 = Ws2.Range("A" & Ws1.Rows.Count).End(xlUp).Row
    
    Dim Cnt
        For Cnt = 2 To Lr3
        Dim VarMtch As Variant
         Let VarMtch = Application.Match(CStr(Ws1.Range("I" & Cnt & "").Value), Ws2.Range("B2:B" & Lr2 & ""), 0)
            If Not IsError(VarMtch) Then
            
            Else
             Ws1.Range("B" & Cnt & ",I" & Cnt & "").Copy
             Let Lr3 = Lr3 + 1
             Ws3.Range("A" & Lr3 & "").PasteSpecial Paste:=xlPasteValues
            End If
        Next Cnt
        
    Wb1.Save
    Wb1.Close
    Wb2.Save
    Wb2.Close
    Wb3.Save
    Wb3.Close
    
        
    End Sub


    the result was pasted in Ws22
    but we have to paste the data(result to Ws3)
    i changed the code and i tried to edit the same but i was unsuccessful in doing so plz see the code and change the vba code so that the result should be pasted in Ws3

  8. #28
    Fuhrer, Vierte Reich DocAElstein's Avatar
    Join Date
    Aug 2014
    Posts
    9,313
    Rep Power
    10
    If the only change is to paste the data to Ws3, then I see just one error in your macro ,
    Why have you changed to
    For Cnt = 2 To Lr3 ?
    It should still be
    For Cnt = 2 To Lr2
    The macro is going down rows in worksheet Ws2 from row 2 until the last row which is Lr2
    My Lr22 = your Lr3 is the row count for data being pasted out : For each new data is needed a new row - the next row - the next row will be .. + 1

    If the only change is to paste to Ws3 , then my original macro is only needed to be changed in 5 places


    Code:
    Sub Step11b() '   http://www.excelfox.com/forum/showthread.php/2421-copy-and-paste-by-VBA-based-on-criteria?p=13110&viewfull=1#post13110  http://www.excelfox.com/forum/showthread.php/2458-Copy-and-paste-the-data-if-condition-met
    Rem 1 Worksheets info
    Dim Wb1 As Workbook, Wb2 As Workbook, Wb3 As Workbook   '                           If the workbook is already open , then we can refer to it using the workbooks collection object of open workbooks,  Workbooks(" ")
     Set Wb1 = .......   Workbooks("1.xls")         ' Workbooks("1.xlsx")         '          Workbooks("sample1.xlsx")   '                                                 Set Wb1 = Workbooks.Open(ThisWorkbook.Path & "\1.xls")                ' w1 = Workbooks.Open("C:\Users\WolfieeeStyle\Desktop\1.xls")           ' change the file path   If the workbook is already open , then we can refer to it using the workbooks collection object of open workbooks,  Workbooks(" ")
     Set Wb2 = .......     Workbooks("2.xls")         ' Workbooks("2.xlsx")         '          Workbooks("sample2.xlsx")   '                                                 Set Wb2 = Workbooks.Open(ThisWorkbook.Path & "\FundsCheck.xlsb")      ' w2 = Workbooks.Open("C:\Users\WolfieeeStyle\Desktop\FundsCheck.xlsb") ' change the file path      If the workbook is already open , then we can refer to it using the workbooks collection object of open workbooks,  Workbooks(" ")
     Set Wb3 = .......
    Dim Ws1 As Worksheet, Ws2 As Worksheet, Ws3 As Worksheet ' Ws22 As Worksheet
     Set Ws1 = Wb1.Worksheets.Item(1)      '                                                                            Set Ws1 = Wb1.Worksheets("anything")  '     sheet name can be anything
     Set Ws2 = Wb2.Worksheets.Item(1)      '                                                                          ' Set Ws2 = Wb2.Worksheets("anything")
    ' Set Ws22 = Wb2.Worksheets.Item(2)
     Set Ws3 = Wb3.Worksheets.Item(2)
    Dim Lr1 As Long, Lr2 As Long, Lr As Long, Lr22 As Long
     Let Lr1 = Ws1.Range("A" & Ws1.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. )
     Let Lr2 = Ws2.Range("A" & Ws1.Rows.Count).End(xlUp).Row
    ' Let Lr = IIf(Lr2 > Lr1, Lr2, Lr1)
    Rem 2 do it
    Dim Cnt
        For Cnt = 2 To Lr2
        Dim VarMtch As Variant
         Let VarMtch = Application.Match(CStr(Ws1.Range("I" & Cnt & "").Value), Ws2.Range("B2:B" & Lr2 & ""), 0) ' We look for the string value from each row in column I of Ws1 in the range of column B in Ws2
            If Not IsError(VarMtch) Then ' If we have a match, then  Application.Match  will return an integer of the position along(down) where the match is found
            ' do nothing
            Else '  Application.Match  will return a VB error string if no match could be found
             Ws1.Range("B" & Cnt & ",I" & Cnt & "").Copy  ' if ranges are "in line" - that is to say have the same "width" ( in this example a single row width ) , then VBA lets us copy this to the clipboard
             Let Lr22 = Lr22 + 1 ' next free row in second worksheet of 2.xls
             'Ws22.Range("A" & Lr22 & "").PasteSpecial Paste:=xlPasteValues ' Pasting of copied values which were "in line" allows us to paste out, but the missing in between bits ( columns in this example ) are missed out - the ranges are put together. Co incidentally we want this output in this example
             Ws3.Range("A" & Lr22 & "").PasteSpecial Paste:=xlPasteValues
            End If
        Next Cnt
    End Sub


    or if you prefer to use a different variable for the row count in Ws3 , Lr3 , then


    Code:
    Sub Step11b() '   http://www.excelfox.com/forum/showthread.php/2421-copy-and-paste-by-VBA-based-on-criteria?p=13110&viewfull=1#post13110  http://www.excelfox.com/forum/showthread.php/2458-Copy-and-paste-the-data-if-condition-met
    Rem 1 Worksheets info
    Dim Wb1 As Workbook, Wb2 As Workbook, Wb3 As Workbook   '                           If the workbook is already open , then we can refer to it using the workbooks collection object of open workbooks,  Workbooks(" ")
     Set Wb1 = .......   Workbooks("1.xls")         ' Workbooks("1.xlsx")         '          Workbooks("sample1.xlsx")   '                                                 Set Wb1 = Workbooks.Open(ThisWorkbook.Path & "\1.xls")                ' w1 = Workbooks.Open("C:\Users\WolfieeeStyle\Desktop\1.xls")           ' change the file path   If the workbook is already open , then we can refer to it using the workbooks collection object of open workbooks,  Workbooks(" ")
     Set Wb2 = .......     Workbooks("2.xls")         ' Workbooks("2.xlsx")         '          Workbooks("sample2.xlsx")   '                                                 Set Wb2 = Workbooks.Open(ThisWorkbook.Path & "\FundsCheck.xlsb")      ' w2 = Workbooks.Open("C:\Users\WolfieeeStyle\Desktop\FundsCheck.xlsb") ' change the file path      If the workbook is already open , then we can refer to it using the workbooks collection object of open workbooks,  Workbooks(" ")
     Set Wb3 = .......
    Dim Ws1 As Worksheet, Ws2 As Worksheet, Ws3 As Worksheet ' Ws22 As Worksheet
     Set Ws1 = Wb1.Worksheets.Item(1)      '                                                                            Set Ws1 = Wb1.Worksheets("anything")  '     sheet name can be anything
     Set Ws2 = Wb2.Worksheets.Item(1)      '                                                                          ' Set Ws2 = Wb2.Worksheets("anything")
    ' Set Ws22 = Wb2.Worksheets.Item(2)
     Set Ws3 = Wb3.Worksheets.Item(2)
    Dim Lr1 As Long, Lr2 As Long, Lr As Long, Lr3 As Long
     Let Lr1 = Ws1.Range("A" & Ws1.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. )
     Let Lr2 = Ws2.Range("A" & Ws1.Rows.Count).End(xlUp).Row
    ' Let Lr = IIf(Lr2 > Lr1, Lr2, Lr1)
    Rem 2 do it
    Dim Cnt
        For Cnt = 2 To Lr2
        Dim VarMtch As Variant
         Let VarMtch = Application.Match(CStr(Ws1.Range("I" & Cnt & "").Value), Ws2.Range("B2:B" & Lr2 & ""), 0) ' We look for the string value from each row in column I of Ws1 in the range of column B in Ws2
            If Not IsError(VarMtch) Then ' If we have a match, then  Application.Match  will return an integer of the position along(down) where the match is found
            ' do nothing
            Else '  Application.Match  will return a VB error string if no match could be found
             Ws1.Range("B" & Cnt & ",I" & Cnt & "").Copy  ' if ranges are "in line" - that is to say have the same "width" ( in this example a single row width ) , then VBA lets us copy this to the clipboard
             Let Lr3 = Lr3+ 1 ' next free row in second worksheet of 2.xls
             'Ws22.Range("A" & Lr22 & "").PasteSpecial Paste:=xlPasteValues ' Pasting of copied values which were "in line" allows us to paste out, but the missing in between bits ( columns in this example ) are missed out - the ranges are put together. Co incidentally we want this output in this example
             Ws3.Range("A" & Lr3 & "").PasteSpecial Paste:=xlPasteValues
            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!!

  9. #29
    Senior Member
    Join Date
    Jul 2019
    Posts
    382
    Rep Power
    0
    Problem Solved
    Thnx Doc Sir for helping me in solving this problem Sir
    Have a Great Day Sir

Similar Threads

  1. Replies: 48
    Last Post: 09-23-2020, 02:03 AM
  2. Replies: 85
    Last Post: 06-09-2020, 05:58 PM
  3. Copy paste data based on criteria
    By analyst in forum Excel Help
    Replies: 7
    Last Post: 01-13-2014, 12:46 PM
  4. Replies: 8
    Last Post: 10-31-2013, 12:38 AM
  5. Replies: 2
    Last Post: 09-18-2013, 12:30 AM

Tags for this Thread

Posting Permissions

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