PDA

View Full Version : Copy row from one workbook to another workbook based on conditions in another Workbook



fixer
07-15-2020, 07:31 PM
Sub STEP6()
Dim Wb1 As Workbook
Dim Wb2 As Workbook
Dim wb3 As Workbook
Dim Ws1 As Worksheet
Dim Ws2 As Worksheet
Dim ws3 As Worksheet
Dim strPath As String
Dim r As Long
Dim m As Long
Dim rng As Range
Dim n As Long
Application.ScreenUpdating = False
Set Wb1 = Workbooks.Open(ThisWorkbook.Path & "1.xls")
Set Ws1 = Wb1.Worksheets(1)
m = Ws1.Range("H" & Ws1.Rows.Count).End(xlUp).Row
strPath = ThisWorkbook.Path & ""
Set Wb2 = Workbooks.Open(strPath & "OrderFormat.xlsx")
Set Ws2 = Wb2.Worksheets(1)
Ws2.Range("A1:A4").TextToColumns DataType:=xlDelimited, Tab:=True, _
SemiColon:=False, Comma:=False, Space:=False, Other:=False, _
ConsecutiveDelimiter:=False
Set wb3 = Workbooks.Open(strPath & "BasketOrder..csv")
Set ws3 = wb3.Worksheets(1)
Set rng = ws3.Cells.Find(what:="*", searchorder:=xlByRows, SearchDirection:=xlPrevious)
If rng Is Nothing Then
n = 1
Else
n = rng.Row + 1
End If
For r = 2 To m
If Ws1.Range("H" & r).Value > Ws1.Range("D" & r).Value Then
Ws2.Range("A1").EntireRow.Copy Destination:=ws3.Range("A" & n)
n = n + 1
ElseIf Ws1.Range("H" & r).Value < Ws1.Range("D" & r).Value Then
Ws2.Range("A3").EntireRow.Copy Destination:=ws3.Range("A" & n)
n = n + 1
End If
Next r
Application.DisplayAlerts = False
Wb1.Close SaveChanges:=False
Wb2.Close SaveChanges:=False
wb3.SaveAs FileName:=strPath & "BasketOrder..csv", FileFormat:=xlCSV
wb3.Close SaveChanges:=False
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub


Condition:If column H of 1.xls is greater than column D of 1.xls then copy third row of orderformat.xlsx & paste it to basketorder.xlsx
If column H of 1.xls is smaller than column D of 1.xls then copy first row of orderformat.xlsx & paste it to basketorder.xlsx

sample file attached below

DocAElstein
07-16-2020, 03:01 PM
Where does the original macro come from?

fixer
07-16-2020, 06:26 PM
I got this macro in 2019 & I have not remebered from which forum i got this macro
Plz see the post I have mentioned all the details & sample file is also attached

DocAElstein
07-20-2020, 12:47 AM
I got this macro in 2019 & I have not remebered from which forum i got this macro
So look for it and find it

fixer
07-20-2020, 01:27 AM
Doc Sir I got this from expertsexchange I think so
& I don't know exactly from which I'd I asked the question from so sorry for the same
But I uploaded the sample file for this problem Sir & I mentioned the details too... Sir

fixer
07-20-2020, 07:35 PM
Unable to find the source of that macro Doc Sir
So forget that macro Sir
i have removed that macro bcoz it was working with .csv file & now i have replaced that file with .xlsx as per needs



At that time i was unaware the .csv file file issue so thats y i replaced the .csv file from the process with .xlsx files
So i need the macro of the same

fixer
07-20-2020, 08:06 PM
http://www.eileenslounge.com/viewtopic.php?f=30&t=34997

fixer
07-20-2020, 10:49 PM
Sub STEP6()
Dim Wb1 As Workbook
Dim Wb2 As Workbook
Dim wb3 As Workbook
Dim Ws1 As Worksheet
Dim Ws2 As Worksheet
Dim ws3 As Worksheet
Dim r As Long
Dim m As Long
Dim rng As Range
Dim n As Long
Application.ScreenUpdating = False
Set Wb1 = Workbooks.Open("C:\Users\WolfieeeStyle\Desktop\1.xls")
Set Ws1 = Wb1.Worksheets(1)
m = Ws1.Range("H" & Ws1.Rows.Count).End(xlUp).Row
Set Wb2 = Workbooks.Open("C:\Users\WolfieeeStyle\Desktop\OrderFormat.xlsx")
Set Ws2 = Wb2.Worksheets(1)
Ws2.Range("A1:A4").TextToColumns DataType:=xlDelimited, Tab:=True, _
SemiColon:=False, Comma:=False, Space:=False, Other:=False, _
ConsecutiveDelimiter:=False
Set wb3 = Workbooks.Open("C:\Users\WolfieeeStyle\Desktop\BasketOrder.xlsx")
Set ws3 = wb3.Worksheets(1)
Set rng = ws3.Cells.Find(what:="*", searchorder:=xlByRows, SearchDirection:=xlPrevious)
If rng Is Nothing Then
n = 1
Else
n = rng.Row + 1
End If
For r = 2 To m
If Ws1.Range("H" & r).Value > Ws1.Range("D" & r).Value Then
Ws2.Range("A1").EntireRow.Copy Destination:=ws3.Range("A" & n)
n = n + 1
ElseIf Ws1.Range("H" & r).Value < Ws1.Range("D" & r).Value Then
Ws2.Range("A3").EntireRow.Copy Destination:=ws3.Range("A" & n)
n = n + 1
End If
Next r
Application.DisplayAlerts = False
Wb1.Close SaveChanges:=False
Wb2.Close SaveChanges:=False
wb3.Close SaveChanges:=True
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub



Problem Solved
Thnx Alot Doc Sir for helping me in solving this problem
Have a Awesome Day

DocAElstein
07-21-2020, 03:59 PM
.....
I have removed that macro bcoz it was working with .csv file .....
please don’t do major edits on posts, after anyone has replied. Minor changes, like correcting mistakes are OK, but do not remove or add a large amount. ( I did tell you about this before, but I expect you forgot )

fixer
07-21-2020, 04:02 PM
I reputted the data
Sorry for the same Doc Sir

DocAElstein
07-22-2020, 02:47 AM
Your final solution may work, but your macro is a lot of mixed up crap with a lot of rubbish in it...

It is not possible to do simple changes to a macro designed to work properly on text files to work instead on Excel files.

But it is impossible to try to explain any of that to you.

fixer
07-22-2020, 09:54 AM
Doc Sir I have uploaded the sample file with output & i have also provided the condition also for this problem Sir

DocAElstein
07-22-2020, 11:24 AM
This forum is for the benefit of people seeking help in Excel and Excel VBA.
So, when I have time , I may complete this thread by answering the initial question.
I will base the answer on the files and the problem description.
The rest of your dribble in the post is based on some history that you are either purposely trying to hide from us or your incompetence on knowing anything about where the original macro or original files are suggests that you should give up with anything to do with computing as you don’t have a chance in hell of ever organising or getting any final working system operational.



I have banned you again, temporarily, to give us a break from you.

You seem to have recently discovered excelforum, ( and most likely a few other places you are keeping secret from us), as a good place, or places, to hide multiple accounts and duplicated cross postings, so I guess you will have no problem continuing your strategy of positing duplicated poorly explained similar postings , seemingly hoping that someone will magically supply a macro or macros that solve some problem that you don’t seem yourself to have any clue about most of the time..
( Possibly someone else is driving you, ( or something in your brain is driving you that probably needs surgery to remove…) )

DocAElstein
07-26-2020, 01:24 PM
Solution ( attempt )
This solution is based solely on the files from Post#1 (https://excelfox.com/forum/showthread.php/2583-Macro-Correction?p=14598&viewfull=1#post14598) and an attempt at the correct question below. Everything else form this post, and at the cross post (http://www.eileenslounge.com/viewtopic.php?f=30&t=34997), is ignored since the OP either
has no idea about
or is unwilling to give any information about the given macros
and statements like “it works perfectly” or macro correction are invalid , unjustified, and are basically a lot of crap.


The question is badly written :( , but we do have an Output :) , ( and an empty initial worksheet**) , so the question will be assumed to be:
The data rows of 1.xls are considered, in particular the values in columns H and D
_____ Workbook: 1.xls ( Using Excel 2007 32 bit )
Row\ColDEFGH
1OpenHighLow Prev CloseLTP

22394.652417.3523502394.652351.9

3156.75161150.05156.8159

441134127.9540374112.54058

517090.05172501670017090.0516700
Worksheet: 1-Sheet1 15July 2020

If column H of 1.xls is greater than column D of 1.xls then copy third row of orderformat.xlsx & paste it to basketorder.xlsx
Else If column H of 1.xls is smaller than column D of 1.xls then copy first row of orderformat.xlsx & paste it to basketorder.xlsx

_____ Workbook: OrderFormat.xlsx ( Using Excel 2007 32 bit )
Row\ColABCDEFGHIJKLMNOPQRSTU
1NSEEQNANANA00BUYMARKETNACLIMISDAYWC5758NA3NA

2NSEEQNANANA00SELLSL-MCLIMISDAYWC5758NANANA

3NSEEQNANANA00SELLMARKETNACLIMISDAYWC5758NA3NA

4NSEEQNANANA00BUYSL-MCLIMISDAYWC5758NANANA
Worksheet: Sheet1 15 July 2020

** I will assume the worksheet in BasketOrder.xlsx is empty initially.
All worksheets are assumed to be the first tab worksheet ( Worksheets.Item(1) )
Here is the given After Output:

_____ Workbook: BasketOrder.xlsx ( Using Excel 2007 32 bit )
Row\ColABCDEFGHIJKLMNOPQRSTU
1NSEEQNANANA00SELLMARKETNACLIMISDAYWC5758NA3NA

2NSEEQNANANA00BUYMARKETNACLIMISDAYWC5758NA3NA

3NSEEQNANANA00SELLMARKETNACLIMISDAYWC5758NA3NA

4NSEEQNANANA00SELLMARKETNACLIMISDAYWC5758NA3NA
Worksheet: Output 15July BasketOrder

( Looking at the results, we see that the OP has got his logic and the Output after results the wrong way around. But that is typical. He is probably Autistic, or has some other brain defect: He often cannot distinguish between greater or smaller. All attempts to explain it to him fail ( https://excelfox.com/forum/showthread.php/2433-vba-Copy-Paste-Conditional-to-put-remark-1-2-3-etc?p=12848&viewfull=1#post12848 ) )



I have done a macro solution to satisfy the OP’s original given logic, https://excelfox.com/forum/showthread.php/2577-Appendix-Thread-(-Codes-for-other-Threads-(-Avinash-)-)?p=14718&viewfull=1#post14718
The basic code description is: We loop down the rows of 1.xls, checking if the column H value is greater or smaller than the column D value. Depending on the result we add a 1 or 3 to an array of indicia that we use in an array type Index calculation to give us the entire required output range in one go.
The macro that satisfies the logic given by the OP, ( https://excelfox.com/forum/showthread.php/2577-Appendix-Thread-(-Codes-for-other-Threads-(-Avinash-)-)?p=14718&viewfull=1#post14718 ) gives these results:


_____ Workbook: BasketOrder.xlsx ( Using Excel 2007 32 bit )
Row\ColABCDEFGHIJKLMNOPQRSTU
1NSEEQNANANA
0
0BUYMARKETNACLIMISDAYWC5758NA
3NA

2NSEEQNANANA
0
0SELLMARKETNACLIMISDAYWC5758NA
3NA

3NSEEQNANANA
0
0BUYMARKETNACLIMISDAYWC5758NA
3NA

4NSEEQNANANA
0
0BUYMARKETNACLIMISDAYWC5758NA
3NA
Worksheet: Sheet1 15 July

DocAElstein
07-26-2020, 01:55 PM
Avinash,
As often, you had a very, very simple problem. The solution was very simple. You also probably had a very good solution, one particularly suited to efficiently solving your problem
As often you have managed to totally mess up everything and make the issues 100 times more difficult for anyone to help you with.
Because
Your explanations are usually bad and incomplete.
You post mostly rubbish and nonsense in your replies that confuse the issue further.
You are on yet another useless time wasting strategy of taking well written macros that may or may not have any relevance to the issue at hand ( since you either know nothing about them or withhold information about them ), then you post them with the title “Macro correction”. Your new strategy just increases further your best talent: Making every issue 100 times more difficult for everyone and getting in a total chaotic mess.

Bro, you are a fucking disaster. The way you are going, you will have no hope in hell of achieving anything other than failure in all that you do, unless your aim is to waste people’s time and annoy them. This you are very good in, better than any question askers that I have ever seen.

Alan

Edit…
It never stops… Some people make mistakes sometimes. Avinash mostly makes mistakes, and mostly does not even realise, or due to some brain defect, Autism, or just total idiocy, can’t even see the obvious, even when told a 100 times…

……Condition:If column H of 1.xls is greater than column D of 1.xls then copy third row ……But i am 100% aware of my logic, my logic is always correct ….. My logic in this problem is (If column H is lower than column D then copy the third row, why we copied the third row bcoz….