copy cell value from one workbook to another based on two criterias

[Aramiu]

Hello,

I'm new to vba and I need help for developing a way to copy cell values from a workbook to another. I require the vba to copy all the cells that have values from columns B,C,D,E,F from the first workbook (3rd sheet), and place them in the other workbook, only if cells in column B from the first workbook have values. The problem is that based on the following condition: cells in column E > cells in column D (workbook A), the values have to be pasted in different locations in the second workbook, in the next free row. All cells that need to be copied must be pasted in the first sheet in workbook 2.
So, to resum:

workbook A, workshhet 1, if the first cell in column B has values, copy in column A in workbook B, first sheet; also, based on the condition that the first cell in column B has values (workbook A), also copy the other cells from columns C,D,E,F, using the following algorithm:

If cell value in column E is bigger than cell value in column D, copy cell from column C in column H (workbook B), copy cell from column D in column J (workbook 2), copy cell from column E in column K (workbook B), copy cell in column F to cell in column L (workbook B), otherwise, if condition is not true, copy cell value from column C in column O (workbook B), don't do anything with cells from column D, copy cell from column E in column P(workbook B), copy cell from column F to cell in column Q (workbook B). Do the same for all rows in workbook A, that have values in the cells from column B and paste the values using the above algorithm in the first free row that doesn't have any value in the column A cells.
Please, I would very much appreciate any help that you can provide. Thank you!

1313413135

[Yongle]

To test that I have understood your requirement, please copy your data into sheet ws1 in the attached workbook and run the macro.
The macro assumes that data starts at row4 because that is where it starts in the image you posted
The macro copies the data from sheet ws1 and based on the criteria should put them in the correct columns and rows in sheet ws2
If this is doing what you want then I will tell you how to modify the code to make it copy into a different workbook.




Sub copyvalues()
'declare variables
Dim i As Integer
Dim LastRow As Long, NextRow As Long
Dim ws1 As Worksheet, ws2 As Worksheet
Dim wb1 As Workbook, wb2 As Workbook
'set the worksheets
Set ws1 = Worksheets("ws1")
Set ws2 = Worksheets("ws2")
'last row with data to copy from
LastRow = ws1.Range("B1048576").End(xlUp).Row
'next row to copy to
If ws2.Range("H1048576").End(xlUp).Row > ws2.Range("o1048576").End(xlUp).Row Then
NextRow = ws2.Range("H1048576").End(xlUp).Offset(1, 0).Row
Else
NextRow = ws2.Range("o1048576").End(xlUp).Offset(1, 0).Row
End If
For i = 2 To LastRow
If ws1.Cells(i, 2) <> "" Then
If ws1.Cells(i, 5).Value > ws1.Cells(i, 4).Value Then
ws1.Cells(i, 3).Copy
ws2.Cells(NextRow, 8).PasteSpecial xlAll
ws1.Cells(i, 4).Copy
ws2.Cells(NextRow, 9).PasteSpecial xlAll
ws1.Cells(i, 5).Copy
ws2.Cells(NextRow, 10).PasteSpecial xlAll
ws1.Cells(i, 6).Copy
ws2.Cells(NextRow, 11).PasteSpecial xlAll
Else
ws1.Cells(i, 3).Copy
ws2.Cells(NextRow, 14).PasteSpecial xlAll
'Do not copy column D
ws1.Cells(i, 5).Copy
ws2.Cells(NextRow, 15).PasteSpecial xlAll
ws1.Cells(i, 6).Copy
ws2.Cells(NextRow, 16).PasteSpecial xlAll


End If
Else
'do not copy
End If
NextRow = NextRow + 1
Next i


End Sub

[Aramiu]

First of all, thank you very much for your reply. I tried out your code and it is almost perfect. I made a few adjustments, as maybe, I haven't written the instructions very clear. It doesn't do exactly what it suppose and I need your help, if you can provide it. The source sheet table that you saw in the first picture is actually a dynamic array formula that extracts those entries from another sheet. So the condition:If ws1.Cells(i, 2) <> "", actually copies all the entries in the outpout sheet (maybe that's because it recognizes the array formula in the empty cells). Yes the data starts from row number 4, but above it, there is a head table written and it is also copied in the outpout sheet. Otherwise, it does the job perfect. I'm going to attach both sheets (the source and the outpout-after running the adjusted vba code). The "Alarme" sheet is the source from where the array formula extracts data (it doesn't have anything to do with the code).
PS: I've created a copy of the workbook to attach it inside this post. I had started the code once again, inside this copy, and now it doesn't copy all the entries from the source sheet...I'm going to attach also a print of the original workbook, outpout sheet.




Sub copyvalues()
'declare variables
Dim i As Integer
Dim LastRow As Long, NextRow As Long
Dim ws1 As Worksheet, ws2 As Worksheet
Dim wb1 As Workbook, wb2 As Workbook
'set the worksheets13142
Set ws1 = Worksheets("Sheet1")
Set ws2 = Worksheets("Sheet3")
'last row with data to copy from
LastRow = ws1.Range("B1048576").End(xlUp).Row
'next row to copy to
If ws2.Range("H1048576").End(xlUp).Row > ws2.Range("o1048576").End(xlUp).Row Then
NextRow = ws2.Range("H1048576").End(xlUp).Offset(1, 0).Row
Else
NextRow = ws2.Range("o1048576").End(xlUp).Offset(1, 0).Row
End If
For i = 2 To LastRow
If ws1.Cells(i, 2) <> "" Then
ws1.Cells(i, 2).Copy
ws2.Cells(NextRow, 1).PasteSpecial xlValues
If ws1.Cells(i, 5).Value > ws1.Cells(i, 4).Value Then
ws1.Cells(i, 3).Copy
ws2.Cells(NextRow, 8).PasteSpecial xlValues
ws1.Cells(i, 4).Copy
ws2.Cells(NextRow, 9).PasteSpecial xlValues
ws1.Cells(i, 5).Copy
ws2.Cells(NextRow, 10).PasteSpecial xlValues
ws1.Cells(i, 6).Copy
ws2.Cells(NextRow, 11).PasteSpecial xlValues
Else
ws1.Cells(i, 3).Copy
ws2.Cells(NextRow, 14).PasteSpecial xlValues
'Do not copy column D
ws1.Cells(i, 5).Copy
ws2.Cells(NextRow, 15).PasteSpecial xlValues
ws1.Cells(i, 6).Copy
ws2.Cells(NextRow, 16).PasteSpecial xlValues


End If
Else
'do not copy
End If
NextRow = NextRow + 1
Next i


End Sub




1314113142

[Yongle]

Your first issue

The source sheet table that you saw in the first picture is actually a dynamic array formula that extracts those entries from another sheet.
So the condition:If ws1.Cells(i, 2) <> "", actually copies all the entries in the outpout sheet (maybe that's because it recognizes the array formula in the empty cells)


Please copy the formula that is entered in cell B4 and paste it into your reply

thanks

[Yongle]

Your 2nd issue

Yes the data starts from row number 4, but above it, there is a head table written and it is also copied in the outpout sheet.
Are you saying that you want the macro to copy the values from Range( B1 : F3) to the output sheet?

If so in order to match where we have copied the data I would expect :
B1 : B3 not copied
C1 : C3 copy to : ws2 H1 : H3 AND to : O1 : O3
D1: D3 copy to : ws2 J1 : J3 AND to : n/a
E1 : E3 copy to : ws2 K1 : L3 AND to : P1 : P3
F1 : F3 copy to : ws2 M1 : M3 AND to : Q1 : Q3

Is this correct?

[Aramiu]

This is the formula in B4: {=IFERROR(IF((INDEX(Alarme!B$24:B$1428;SMALL(IF(Alarme!$CY$24:$CY$1428=TRUE ;ROW(Alarme!B$24:B$1428)-ROW(Alarme!B$24)+1); ROWS(Alarme!B$24:Alarme!B24))))=0;"";INDEX(Alarme!B$24:B$1428;SMALL(IF(Alarme!$CY$24:$CY$1428=TRUE;ROW(Alarme!B $24:B$1428)-ROW(Alarme!B$24)+1); ROWS(Alarme!B$24:Alarme!B24))));"")}. But, as I told you before, after I saved a copy of the workbook (the one I attached in my previous post), it copies just those entries that it should. I don't know why in the original workbook it also copies the entries with no values in B column (as it is shown in my previous post print screen).

B1:B3; C1:C3, D1: D3, E1:E3 and F1:F3, all of them don't require copying. The positions pasted in "ws2" are ok for the current code, it's just that it copies also cells from from rows 1 to 3, which contain the table head. So the conditions should start from row number 4.

[Aramiu]

I attached the whole workbook, next to the picture: "Test.xlm"

[Yongle]

The source sheet table that you saw in the first picture is actually a dynamic array formula that extracts those entries from another sheet.
So the condition:If ws1.Cells(i, 2) <> "", actually copies all the entries in the outpout sheet (maybe that's because it recognizes the array formula in the empty cells)
Try replacing the "" in

If ws1.Cells(i, 2) <> "" Then
with a zero :

If ws1.Cells(i, 2) <> 0 Then

[Aramiu]

No. It still copies all other cells, that don't have values in column B. And what about the first 3 rows? how do I configure the code so it will not copy them also?

[Yongle]

So the conditions should start from row number 4.

Amend this line in the code from:

For i = 2 To LastRow
to

For i = 4 To LastRow

[Aramiu]

Dooohhhhh!!! Stupid Me! That makes sense! :(

That's perfect! Still don't know how to run the code for another sheet in another workbook and how to get the code to not copy all the lines...

Thank you very much for everything.

[Yongle]

No. It still copies all other cells, that don't have values in column B

Let's try something different. I think you are correct that the array formula is probably what is causing the problem. Can you please try this test in a copy of your workbook. I want to try to see if the condition works without the formula in column B

Do the following
- in your test copy of the workbook:
- select column B (from B4 to the last row)
- right click with mouse and select copy
- right click again and select paste special / values
Please check the first and last cell in column B to make sure that the formula is no longer there.

Now try running the macro again first with

If ws1.Cells(i, 2) <> 0 Then
and if that does not work with

If ws1.Cells(i, 2) <> "" Then

If this does not work please attach the test copy workbook (the one after you have pasted values) to your reply (you can do that by clicking on Go Advanced and clicking on the paperclip. If the details in your file are confidential, delete all the information in all columns except column B.

thanks
PS - glad that one of your problems is solved

[Yongle]

Still don't know how to run the code for another sheet in another workbook

I deal with problems one by one. If we change too many things at once, then we get in a bigger mess than we started with. Also having more than one workbook open when testing is a nuisance. I always try to test in one workbook and at the very end of the process, when everything else is working, change the instructions to copy the output to a different workbook.

What is the name of the other workbook?
What is the name of the sheet that the data will be copied to?
Does the workbook exist or will our macro add a new workbook?
Does the sheet exist or will our macro add a new sheet?

thanks
PS - In a few minutes, I will be away from my PC for a few hours. Off outut to enjoy some sunshine and beer!

[Aramiu]

Ok. I figuered it out. That array formula is put inside an IFERROR statement, so that when it reports an error (or there is no data) it puts a " " (space) in the cell...So I modified the line code with " ", instead of "", and it works. Also tested the solution for the sheet that has the array formula.

[Aramiu]

Now I only have to put the code to work for another sheet in another workbook...

[Aramiu]

You are right! It's best to deal with one problem at a time. Workbook exists. It's the second picture in my original post. It is called : "8 Penalitati Model.xls". It has 17 sheets. But the output one is the first and it is called: "PENALITATI". Is it possible to make the code in a way that it will open the workbook if it is closed and just paste the cells if it is allreay opened? Or if you have any recommendation, I will gladly listen to it.

[Aramiu]

OK. Enjoy! It's a beautiful day here as well. Unfortunately i'm at work... :( Thank you for everything!

[Yongle]

Now I only have to put the code to work for another sheet in another workbook.
This code (to be amended by you as detailed below) should help you now create the code to save into a different workbook


On Error Resume Next
Application.DisplayAlerts = False
Workbooks("8 Penalitati Model.xls").Close True
Application.DisplayAlerts = True
On Error GoTo 0
Set wb2 = Workbooks.Open("D:\Documents\VBAForum\8 Penalitati Model.xls")
Set ws2 = wb2.Sheets("PENALITATI")

Amendments
In your current code there is a line beginning with Set ws2 =
1 Replace that one line with ALL of the above code
2 Replace the path D:\Documents\VBAForum\ with the correct path for your system
3 Replace all the values 1048576 with 65536
To do this select the relevant lines in the code and use ctrl + H which will open up the Replace box into which you place the above values
(this is necessary because your file "8 Penalitati Model.xls" is an Excel2003 file with fewer rows than later files)


How the code works

These lines below save and close file 8 Penalitati Model.xls, with error handling wrapped around so that VBA can handle the situation if the file is not open, without it stopping the macro from running.

On Error Resume Next
Application.DisplayAlerts = False
Workbooks("8 Penalitati Model.xls").Close True
Application.DisplayAlerts = True
On Error GoTo 0


These 2 lines tell VBA that ws2 is sheet "PENALITATI" in the other workbook

Set wb2 = Workbooks.Open("D:\Documents\VBAForum\8 Penalitati Model.xls")
Set ws2 = wb2.Sheets("PENALITATI")

[Yongle]

(from Post#14 - Ok. I figuered it out. That array formula is put inside an IFERROR statement, so that when it reports an error (or there is no data) it puts a " " (space) in the cell...So I modified the line code with " ", instead of "", and it works. Also tested the solution for the sheet that has the array formula.

I am not suggesting that you amend your code. This is for info only.

Use TRIM function to eliminate "annoying" spaces in cells that need to be "blank ", by amending:

if ws1.Cells(i, 2) <> "" Then
to either:


if Trim((ws1.Cells(i, 2)) <> "" Then

or possibly:

if Trim(ws1.Cells(i, 2).value) <> "" Then

The TRIM function eliminates all spaces except single spaces between words - so it would sort out the problem with 1 space, 2 spaces, 10 spaces..
The trim function also exists in Excel, so you could create another column with the formula =TRIM(B4) etc and use that column to test for blank cells. instead of columnB. (If you are very brave and clever :clever: you could even build the TRIM function into the formulas in column B, to eliminate the problem at source - but perhaps the formulas are too complicated already :jester:)


Did you try the code in post#18?

[Aramiu]

I'm working on it as I write this post :yes . The formula used to create that dynamic array is km long...so inserting the TRIM function (that I know about) could complicate things. But your ideea with a separate approach on the cells containing blanks is great, and I will put it to work. I'll post some feedback after I modify the code.

[Aramiu]

Ok. It's as perfect as it can be!!! I don't have enough words to express my gratitude! Your help was amazing. I'm totally in debt.

Can I stress you some more with a couple of questions? I like to understand the code that I use, so that I can learn and manage on my own in the future. In this case, the only trouble I came across, was the exact meaning of these lines:



If ws2.Range("H1048576").End(xlUp).Row > ws2.Range("o1048576").End(xlUp).Row Then
NextRow = ws2.Range("H1048576").End(xlUp).Offset(1, 0).Row
Else
NextRow = ws2.Range("o1048576").End(xlUp).Offset(1, 0).Row
End If

And I ask this, because I tried to adapt this code for another task and it all went smoothly, except the fact that the pasted values don't arrange themselves following the empty rows in the output sheet. They follow the arrangement from the source sheet, where they are interupted by other rows that don't meet the criteria. So if in the source sheet there's an entry that has to be copied from, let's say, A2, A6, A9, A15, the output file will keep the missing cells from the column, as empty rows (with no data): A1-Blank, A2-correct data-A3,A4,A5-blanks, A6-correct data, etc. This is the code:


Sub copyvalues()
Dim i As Integer
Dim LastRow As Long, NextRow As Long
Dim ws1 As Worksheet, ws2 As Worksheet
Dim wb1 As Workbook, wb2 As Workbook

Set ws1 = Worksheets("Sheet1")
On Error Resume Next
Application.DisplayAlerts = False
Workbooks("3 Interventii .xls").Close True
Application.DisplayAlerts = True
On Error GoTo 0
Set wb2 = Workbooks.Open("C:\Users\cna\Desktop\3 Interventii .xls")
Set ws2 = wb2.Sheets("POSTURI PAZA")
LastRow = ws1.Range("B65536").End(xlUp).Row
NextRow = ws2.Range("A65536").End(xlUp).Offset(1, 0).Row



For i = 12 To LastRow

If ws1.Cells(i, 10) = Date Then

ws1.Cells(i, 3).Copy
ws2.Cells(NextRow, 1).PasteSpecial xlValues

Else
End If

NextRow = NextRow + 1
Next i


End Sub

[Yongle]

I like to understand the code that I use, so that I can learn and manage on my own in the future. In this case, the only trouble I came across, was the exact meaning of these lines:



If ws2.Range("H1048576").End(xlUp).Row > ws2.Range("o1048576").End(xlUp).Row Then
NextRow = ws2.Range("H1048576").End(xlUp).Offset(1, 0).Row
Else
NextRow = ws2.Range("o1048576").End(xlUp).Offset(1, 0).Row
End If


The previous line was pasted EITHER to columns H,I,J,K OR to O,P,Q
So to find out the next row, the code is checking to see whether Column H or O has the previous line
- it does this by going to the bottom of both columns and
- then - by using End(xlUP) - finds the last cell with an entry in both columns and
- .row gives the row number and
- uses the greater of the two row numbers

This method works here because we are posting to totally separate ranges and we cannot test one column to find the last cell.
There are other ways to achieve the same result, that would also work here
- use a variable (or a cell) to Keep a record of the row number at the time of pasting and add 1 to it each time
- put a marker in column H (eg a space) when we paste to columns O,P,Q and then we could always test column H for the last cell
etc

I am glad that you want to understand exactly what the code is doing which is very important if something goes wrong later, or if you need to amend the code.

Does this help you answer your other question?