Thnx Alan Elston Sir (Doc Sir)
Thnx Alan Elston Sir (Doc Sir)
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
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 )
Worksheet: Sheet1 (2)
Row\Col Stock Name Data Data Data Data Data Data Data Data Data Data Data Data ACC ADANIENT ADANIPORTS ADANIPOWER AMARAJABAT AMBUJACEM ONGC
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 )
Worksheet: Tabelle2
Row\Col ACC 500 ADANIENT 700 AMARAJABAT 400
macro is here : https://imgur.com/Rs0EaVf , and also in uploaded file.
Attachment 2838
Thnx Alot Doc Sir for helping me in solving this problem
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
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 )
Worksheet: Sheet1 (2)
Row\Col Exchange NSE 25 NSE 10583 NSE 17388 NSE 100
_____ Workbook: 2.xls ( Using Excel 2007 32 bit )
Worksheet: Sheet2
Row\Col
_____ Workbook: 1.xls ( Using Excel 2007 32 bit )
Worksheet: 1-Sheet1
Row\Col Exchange Symbol Series/Expiry Open High Low Prev Close LTP NSE ADANIENT EQ NSE ACC EQ NSE DLF EQ NSE AMBUJACEM EQ NSE AMARAJABAT EQ
After results
_____ Workbook: 2.xls ( Using Excel 2007 32 bit )
Worksheet: Sheet2
Row\Col ACC
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
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
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
Problem Solved
Thnx Doc Sir for helping me in solving this problem Sir
Have a Great Day Sir
Posting Permissions
Reply With Quote
Bookmarks