Previous Topic Next Topic

Copy certain cells when an option is selected

Solved/Closed
Fwong Posts 11 Registration date Friday May 15, 2015 Status Member Last seen June 5, 2015 - May 18, 2015 at 06:26 AM
vcoolio Posts 1404 Registration date Thursday July 24, 2014 Status Moderator Last seen September 15, 2023 - May 27, 2015 at 02:19 AM
Hello,

Can anyone help me with a script to:
Copy:
cell A, Worksheet One to cell B, Worksheet Two;
cell G, Worksheet One to cell D, Worksheet Two;
cell J, Worksheet One to cell C, Worksheet Two
from the row where "YES" is selected from an option list in cell AA in Worksheet One to the next blank row in Worksheet Two.

Thanks and much appreciated for your help,
FW

8 responses

Answer 1 / 8
vcoolio Posts 1404 Registration date Thursday July 24, 2014 Status Moderator Last seen September 15, 2023 259
May 27, 2015 at 02:19 AM
Hello Felicia,

So everything is basically the same as per my post #12 except that you now want J from sheet 1 to be copied over to J in sheet 2 instead of C. Is this correct?

Cheerio,
vcoolio.
4
Answer 2 / 8
vcoolio Posts 1404 Registration date Thursday July 24, 2014 Status Moderator Last seen September 15, 2023 259
May 25, 2015 at 07:19 AM
Hello Felicia,

I think that we have it this time:- 

Private Sub Worksheet_Change(ByVal Target As Range)

If Intersect(Target, Columns("AA:AA")) Is Nothing Then Exit Sub
If Target.Cells.Count > 1 Then Exit Sub

Application.ScreenUpdating = False
Application.EnableEvents = False

Dim lRow As Long

lRow = Range("A" & Rows.Count).End(xlUp).Row
    
Sheets("sheet1").Select

For Each cell In Range("AA2:AA" & lRow)
      If cell.Value = "Yes" Then
      If Cells(cell.Row, "A") = "" Then
      Cells(cell.Row, "A") = " "
End If
      If Cells(cell.Row, "G") = "" Then
      Cells(cell.Row, "G") = " "
End If
      If Cells(cell.Row, "J") = "" Then
      Cells(cell.Row, "J") = " "
End If
End If
Next cell

For Each cell In Range("AA2:AA" & lRow)
      If cell.Value = "Yes" Then
      Cells(cell.Row, "A").Copy
      Sheets("Sheet2").Range("B" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
      Cells(cell.Row, "G").Copy
      Sheets("Sheet2").Range("D" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
      Cells(cell.Row, "J").Copy
      Sheets("Sheet2").Range("C" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
      End If
Next cell

Sheets("Sheet2").Range("B1:D" & Rows.Count).RemoveDuplicates Columns:=Array(1, 2, 3), Header:=xlYes
Application.EnableEvents = True
Application.ScreenUpdating = True
Application.CutCopyMode = False
Sheets("Sheet2").Select

End Sub


Here is an updated sample for you to play with:-

https://www.dropbox.com/s/ymr334b4hak9xxo/Fwong%285%29.xlsm?dl=0

In the sample, I've left out random red coloured text and, on transferring, the code does as you would like. Delete/add more text as you wish in the sample to see how it works.

Cheerio,
vcoolio.
3
Answer 3 / 8
vcoolio Posts 1404 Registration date Thursday July 24, 2014 Status Moderator Last seen September 15, 2023 259
May 19, 2015 at 09:23 AM
Hello Fwong,

The following code may do the job for you:- 

Sub CopyStuff()

Application.ScreenUpdating = False

Dim lRow As Long

lRow = Range("A" & Rows.Count).End(xlUp).Row

For Each cell In Range("AA2:AA" & lRow)
      If cell.Value = "Yes" Then
      Range(Cells(cell.Row, "A"), Cells(cell.Row, "A")).Copy
      Sheets("Sheet2").Range("B" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
      Range(Cells(cell.Row, "G"), Cells(cell.Row, "G")).Copy
      Sheets("Sheet2").Range("D" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
      Range(Cells(cell.Row, "J"), Cells(cell.Row, "J")).Copy
      Sheets("Sheet2").Range("C" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
      End If
Next cell

Application.ScreenUpdating = True
Application.CutCopyMode = False
Sheets("Sheet2").Select

End Sub


You can peruse my test work book here:-

https://www.dropbox.com/s/t9a1podh2st1woh/Fwong.xlsm?dl=0

to see if it the code does what you would like.

Do you need the data in sheet 1 cleared once it is transferred to sheet 2?

I hope that this helps.

Cheerio,
vcoolio.
2
Fwong Posts 11 Registration date Friday May 15, 2015 Status Member Last seen June 5, 2015
May 20, 2015 at 07:06 AM
Hi vcoolio,

Thanks very much for your script. I have tested it but noticed a few things:
1) the copying from cell J in worksheet one to cell C in worksheet two did not work
2) I would like the macro to run automatically whenever YES is entered for that row e.g. Once YES is entered in cell AA in row 2 in worksheet one, the required cells in row 2 in worksheet one will be copied to respective cells in row 2 in worksheet two.
Then if YES is entered in cell AA in row 5 in worksheet one, the required cells in row 5 in worksheet one will be copied to respective cells in the next blank row ie row 3 in worksheet two.
Then if YES is entered in cell AA in row 8 in worksheet one, the required cells in row 8 in worksheet one will be copied to respective cells in in the next blank row ie row 4 in worksheet two.

Hence the TRANSFER is not needed. The entry of YES is the trigger of the copying and pasting action.

In the meantime, I do not require removing of the cells from Worksheet One once the copying and pasting is done.

Thanks again for your script and hope to see your revised script soon.

Thanks a lot,
Felicia
0
Answer 4 / 8
vcoolio Posts 1404 Registration date Thursday July 24, 2014 Status Moderator Last seen September 15, 2023 259
May 21, 2015 at 08:24 AM
Hello Felicia,

According to your first post, you want data from cells in Columns A, G and J in sheet 1 transferred to Columns B, C and D in sheet 2 once the criteria "Yes" is typed/selected in Column AA in sheet 1.
This is exactly what the code does! To test it, did you type in "Yes" in any of the other Column AA cells in the test work book besides the ones that already have "Yes" typed in them? It is after all, a sample of what the code does.

If you do not want to click on the button to transfer the data, then we can make the code a Worksheet_Change event as follows:- 
Private Sub Worksheet_Change(ByVal Target As Range)

If Intersect(Target, Columns("AA:AA")) Is Nothing Then Exit Sub
Application.ScreenUpdating = False
Application.EnableEvents = False

Dim lRow As Long

lRow = Range("A" & Rows.Count).End(xlUp).Row

For Each cell In Range("AA2:AA" & lRow)
      If cell.Value = "Yes" Then
      Range(Cells(cell.Row, "A"), Cells(cell.Row, "A")).Copy
      Sheets("Sheet2").Range("B" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
      Range(Cells(cell.Row, "G"), Cells(cell.Row, "G")).Copy
      Sheets("Sheet2").Range("D" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
      Range(Cells(cell.Row, "J"), Cells(cell.Row, "J")).Copy
      Sheets("Sheet2").Range("C" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
      End If
Next cell
Application.EnableEvents = True
Application.ScreenUpdating = True
Application.CutCopyMode = False
Sheets("Sheet2").Select

End Sub


Place the code in the worksheet module (right click on the sheet 1 tab, select "View Code" and in the big white field, paste the above code). Every time that you type/select "Yes" in a cell in Column AA, the data you need will be transferred to sheet 2. Please note that "Yes" is case sensitive.

You can find my updated test work book to peruse here:-

https://www.dropbox.com/s/t9a1podh2st1woh/Fwong.xlsm?dl=0

Cheerio,
vcoolio.
2
Fwong Posts 11 Registration date Friday May 15, 2015 Status Member Last seen June 5, 2015
May 22, 2015 at 07:41 AM
Hi vcoolio,

Thanks for your email. I have tested again - everything went well - correct cells copied across to the next blank row. The only problem is apart from copying that row where Yes is entered, all other rows which have Yes are also copied across (hence all previously copied rows are copied again whenever a Yes is entered).

I would greatly appreciate if you could edit your current script so that only "that" row where Yes is entered is copied across. Hence every time only ONE row is copied when Yes is entered.

Thanks very much, really appreciate your help.

Await your revised script,
Felicia
0

Didn't find the answer you are looking for?

Ask a question
Answer 5 / 8
vcoolio Posts 1404 Registration date Thursday July 24, 2014 Status Moderator Last seen September 15, 2023 259
May 22, 2015 at 08:38 AM
Hello Felicia,

That's why I asked this question in Post #1: 

Do you need the data in sheet 1 cleared once it is transferred to sheet 2?


If the "used" data is cleared from Sheet 1, then there wouldn't be any duplication in Sheet 2.

However, sheet 2 can be cleared prior to any new data being transferred which means that you can keep all data in sheet 1 and not have duplicate entries in sheet 2 as well.

So, replace the original code with the following one: 

Private Sub Worksheet_Change(ByVal Target As Range)

If Intersect(Target, Columns("AA:AA")) Is Nothing Then Exit Sub
Application.ScreenUpdating = False
Application.EnableEvents = False

Dim lRow As Long

lRow = Range("A" & Rows.Count).End(xlUp).Row
Sheets("Sheet2").Range("B2:D" & lRow).ClearContents

For Each cell In Range("AA2:AA" & lRow)
      If cell.Value = "Yes" Then
      Cells(cell.Row, "A").Copy
      Sheets("Sheet2").Range("B" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
      Cells(cell.Row, "G").Copy
      Sheets("Sheet2").Range("D" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
      Cells(cell.Row, "J").Copy
      Sheets("Sheet2").Range("C" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
      End If
Next cell

Application.EnableEvents = True
Application.ScreenUpdating = True
Application.CutCopyMode = False
Sheets("Sheet2").Select

End Sub


Another way to prevent duplication in Sheet 2 (assuming that you have a Data Validation drop down in Column AA with "Yes", "No", "Maybe" etc. in it) is to change the criteria entry to "No" for example. This way would, obviously, create extra work for you especially if your data set is large. I'll leave it to you.

I have also trimmed the code just to make it a little more efficient.

I hope that this helps.

Cheerio,
vcoolio.
2
Fwong Posts 11 Registration date Friday May 15, 2015 Status Member Last seen June 5, 2015
May 23, 2015 at 02:32 AM
Hi vcoolio,

Thanks for your revised script. Now it does not have duplicates. But there are now 2 minor issues:
1) after copying the rows from Worksheet One to Worksheet Two, the copied cells are automatically resorted alphabetically. What I would like is not to resort the cells - the latest copied rows should always be the last row in Worksheet Two. Please do not resort them. But let them be in the order as they are copied (ie it can be cells BB, DD,AA,CC,GG, etc).
2) When I removed the Yes from Worksheet One, all of the previously copied cells in Worksheet two are also removed. Please keep all copied cells in Worksheet Two. There is a reason for this: Worksheet One is an extraction from other databases which can come from different sources. The major requirement of the users is to keep Worksheet Two constant once an action is completed (ie once Yes is entered).

Please advise if I was not clear in my above requirements. Again look forward to your revised script.

Thanks very much for your patience and effort,
Felicia
0
vcoolio Posts 1404 Registration date Thursday July 24, 2014 Status Moderator Last seen September 15, 2023 259 > Fwong Posts 11 Registration date Friday May 15, 2015 Status Member Last seen June 5, 2015
May 23, 2015 at 05:38 AM
Hello Felicia,

A Worksheet_Change event sorts itself. Its not actually in the code above.
The best way to do what you want with a Work_sheet Change event is to clear the entries from the Input sheet (Sheet 1 in this case):- 


Private Sub Worksheet_Change(ByVal Target As Range)

If Intersect(Target, Columns("AA:AA")) Is Nothing Then Exit Sub
Application.ScreenUpdating = False
Application.EnableEvents = False

Dim lRow As Long

lRow = Range("A" & Rows.Count).End(xlUp).Row

For Each cell In Range("AA2:AA" & lRow)
      If cell.Value = "Yes" Then
      Cells(cell.Row, "A").Copy
      Sheets("Sheet2").Range("B" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
      Cells(cell.Row, "G").Copy
      Sheets("Sheet2").Range("D" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
      Cells(cell.Row, "J").Copy
      Sheets("Sheet2").Range("C" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
      Sheets("Sheet1").Range(Cells(cell.Row, "A"), Cells(cell.Row, "AA")).ClearContents
      End If
Next cell

Columns("A").SpecialCells(4).EntireRow.Delete
Application.EnableEvents = True
Application.ScreenUpdating = True
Application.CutCopyMode = False
Sheets("Sheet2").Select

End Sub


This will also prevent the Input sheet from becoming unnecessarily large (which will eventually also slow down the code).

https://www.dropbox.com/s/hd5ngsdrxj21szr/Fwong%282%29.xlsm?dl=0

Cheerio,
vcoolio.
0
Answer 6 / 8
vcoolio Posts 1404 Registration date Thursday July 24, 2014 Status Moderator Last seen September 15, 2023 259
May 23, 2015 at 06:16 AM
Hello again Felicia,

This slightly modified version of the above code should also do as you would like (your post #6): 

Private Sub Worksheet_Change(ByVal Target As Range)

If Intersect(Target, Columns("AA:AA")) Is Nothing Then Exit Sub
Application.ScreenUpdating = False
Application.EnableEvents = False

<code basic>Dim lRow As Long

lRow = Range("A" & Rows.Count).End(xlUp).Row

For Each cell In Range("AA2:AA" & lRow)
      If cell.Value = "Yes" Then
      Cells(cell.Row, "A").Copy
      Sheets("Sheet2").Range("B" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
      Cells(cell.Row, "G").Copy
      Sheets("Sheet2").Range("D" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
      Cells(cell.Row, "J").Copy
      Sheets("Sheet2").Range("C" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
      End If
Next cell

Sheets("Sheet2").Range("B1:D" & Rows.Count).RemoveDuplicates Columns:=Array(1, 2, 3), Header:=xlYes
Application.EnableEvents = True
Application.ScreenUpdating = True
Application.CutCopyMode = False
Sheets("Sheet2").Select

End Sub


https://www.dropbox.com/s/1hm7u6pe4w6kg2g/Fwong%281%29.xlsm?dl=0

Now you have another option!

Cheerio,
vcoolio.
2
Fwong Posts 11 Registration date Friday May 15, 2015 Status Member Last seen June 5, 2015
May 24, 2015 at 03:19 AM
Hi vcoolio,

Your script works really well this time. I have a little request as the transferred cells in Worksheet One may not always have data. I noticed during transfer one, if a cell does not have data in Worksheet One, this cell in Worksheet Two will then be filled up by data from transfer two if the corresponding cell in Worksheet One has data during transfer two.

Can you please edit the script so that even if the cell does not have data in Worksheet One, it will stay as blank after transfer in Worksheet Two. Data from the subsequent transfers will only copy data to the subsequent rows and will not fill up cells in previous transfers.

Please advise if you require clarification.

Thanks again for your hard work and look forward to this slight improvement.

Regards,
Felicia
0
vcoolio Posts 1404 Registration date Thursday July 24, 2014 Status Moderator Last seen September 15, 2023 259 > Fwong Posts 11 Registration date Friday May 15, 2015 Status Member Last seen June 5, 2015
May 24, 2015 at 07:10 AM
Hello Felicia,

I'm not sure what you are trying to say:- 

 "as the transferred cells in Worksheet One may not always have data".


If they have been transferred, they obviously won't have data in them.
Are you saying that if you have a blank row in Sheet 1, you want it to remain as a blank row? That is, you don't want the blank row removed from the data set? Like this perhaps:- 

Private Sub Worksheet_Change(ByVal Target As Range)

If Intersect(Target, Columns("AA:AA")) Is Nothing Then Exit Sub
Application.ScreenUpdating = False
Application.EnableEvents = False

Dim lRow As Long

lRow = Range("A" & Rows.Count).End(xlUp).Row

For Each cell In Range("AA2:AA" & lRow)
      If cell.Value = "Yes" Then
      Cells(cell.Row, "A").Copy
      Sheets("Sheet2").Range("B" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
      Cells(cell.Row, "G").Copy
      Sheets("Sheet2").Range("D" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
      Cells(cell.Row, "J").Copy
      Sheets("Sheet2").Range("C" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
      Sheets("Sheet1").Range(Cells(Cells.Row, "A"), Cells(cell.Row, "AA")).ClearContents
      End If
Next cell

Application.EnableEvents = True
Application.ScreenUpdating = True
Application.CutCopyMode = False
Sheets("Sheet2").Select

End Sub


https://www.dropbox.com/s/pdqi7y9zfyxyvm8/Fwong%20%283%29.xlsm?dl=0

Or do you mean that you only want the three cells from each row that are to be transferred from sheet 1 to sheet 2 to remain blank with these three blank cells plus the rest of the row not being cleared from sheet 1? Like this:- 

Private Sub Worksheet_Change(ByVal Target As Range)

If Intersect(Target, Columns("AA:AA")) Is Nothing Then Exit Sub
Application.ScreenUpdating = False
Application.EnableEvents = False

Dim lRow As Long

lRow = Range("A" & Rows.Count).End(xlUp).Row

For Each cell In Range("AA2:AA" & lRow)
      If cell.Value = "Yes" Then
      Cells(cell.Row, "A").Copy
      Sheets("Sheet2").Range("B" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
      Cells(cell.Row, "G").Copy
      Sheets("Sheet2").Range("D" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
      Cells(cell.Row, "J").Copy
      Sheets("Sheet2").Range("C" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
      Range(Cells(cell.Row, "A"), Cells(cell.Row, "A")).ClearContents
      Range(Cells(cell.Row, "G"), Cells(cell.Row, "G")).ClearContents
      Range(Cells(cell.Row, "J"), Cells(cell.Row, "J")).ClearContents
      End If
Next cell

Application.EnableEvents = True
Application.ScreenUpdating = True
Application.CutCopyMode = False
Sheets("Sheet2").Select

End Sub


https://www.dropbox.com/s/92rqs3rmr0ae9gv/Fwong%20%284%29.xlsm?dl=0

This one clears just the cells from Columns A, G & J once transferred and leaves them blank but also leaves the rest of the row associated with the transferred cells on sheet 1.

This is becoming somewhat confusing so, if the above is not what you want, then you had best upload a sample of your work book to show us exactly what it is that you are trying to do with a precise description. If you have any sensitive data in your sample, then manually change it to fictitious data. You can upload a sample by using a free file sharing site such as DropBox or ge.tt

Cheerio,
vcoolio.
0
Answer 7 / 8
Fwong Posts 11 Registration date Friday May 15, 2015 Status Member Last seen June 5, 2015
May 24, 2015 at 07:45 AM
Hi vcoolio,

I probably did not express myself clearly. Let's take an example from your file: let's assume in Sheet 1, row 9, cell J9 - instead of having the data of 8HH8, it is blank. When I transfer this row to (let's say) to row 2 in Sheet2. Cell C will be blank. This is correct.
Then I go back to Sheet1, I transfer another row, let's say row 10. Cell J10 in row 10 has data which is 9II9. When this row is transferred to Sheet2 (let's say) row 3, 9II9 is now copied back to row 2, cell C in Sheet2. This is not correct as 9II9 should belong to the record in row 3 and not row 2 in Sheet2.
What I would like to see is for the above examples: Once transferred to Sheet2, row 2 cell C should be blank; Sheet2, row 3 cell C should be 9II9.

Hope the above made sense to you.

Thanks and await your advice,
Felicia
0
Answer 8 / 8
Fwong Posts 11 Registration date Friday May 15, 2015 Status Member Last seen June 5, 2015
May 26, 2015 at 05:26 PM
Hi vcoolio,

I was wondering if the following is doable:
I noticed from your script, all of the cells when copying from Sheet one to Sheet two, they will be copied to the next blank row in Sheet two. Can you amend the script a bit so that:
A, Sheet One will be copied to B in the next blank row, Sheet two.
Then G, Sheet One will be copied to D in the <b>same</b> row as B in Sheet two.
And J, Sheet One will be copied to J in the <b> same</b> row as B in Sheet two.
Hence G and J in Sheet One will actually look at the row of B where B is copied to in Sheet Two (instead of going to the next blank row in Sheet two).

Please advise if the above is OK.

Thanks and await your assistance,
Appreciate,
Felicia
0

Similar discussions

Conditional formating - apply on more cells
Biljana -
Raj -

32 responses
Unable to change resolution on Samsung TV
KarenJDecoteau -
ac3mark -

5 responses
help me to add particular cells
mathewmunna -
mathew munna -

2 responses
How to get out of Apt io setup utility?
SaharSoli -
HelpiOS -

3 responses
there is no disk selected
aminul -
xpcman -

1 response