Copy rows to rows on another worksheet if " ✔ "Solved/Closed

Question

Hi everyone,
Ultimate greenhorn here.
I have just recently discovered the " Conditional Formatting " as well as VBA function on excel a week ago and am having troubles. I tried several codes that was provided on some forums but it doesn't seem to work.

Situation :

I have 2 sheets " K1 " and " Completed "
I would like to duplicate the whole row on " K1 " from cells C5 to Z5 to the sheet named " Completed " if cell Z5 on sheet " K1 " is marked as ✔ or X meaning that it has been completed. It should work not only for this range but C6 to Z6, etc as it goes down the list, as long as it is marked as ✔ or X on column Z.

Is it also possible to make it chronological too based on the dates ?

Not sure if I am asking too much, but your help is greatly appreciated sensei's !

vcoolio · Answer

Hello CassYCS,

Try the following code placed in a standard module and assigned to a button:-

Sub Test()

Dim ws As Worksheet: Set ws = Sheets("K1")
     Dim ws1 As Worksheet: Set ws1 = Sheets("Completed")

Application.ScreenUpdating = False

With ws.Range("Z4", ws.Range("Z" & ws.Rows.Count).End(xlUp))
     .AutoFilter 1, "X", xlOr, ChrW(&H2713)
     ws.Range("C5", ws.Range("Z" & ws.Rows.Count).End(xlUp)).Copy
     ws1.Range("A" & Rows.Count).End(3)(2).PasteSpecial xlValues
     'ws.Range("C5", ws.Range("Z" & ws.Rows.Count).End(xlUp)).EntireRow.Delete
     .AutoFilter
End With

ws1.Range("A2", ws1.Range("X" & ws1.Rows.Count).End(xlUp)).Sort ws1.[A2], 1

Application.CutCopyMode = False
Application.ScreenUpdating = True

End Sub


The code assumes that your data starts in Column C, row5 with headings in row4.
The transferred data is sorted by date ascending in the "Completed" sheet.
If you want the "used" data from the "K1" sheet deleted after each transfer then remove the apostrophe(') from in front of the green coloured line of code (line 12).

Please test the code in a copy of your workbook first.

I hope that this helps.

Cheerio,
vcoolio.

vcoolio · Answer

Hello CassYCS,

You had best upload a sample of your workbook for us to work with.

Upload your file to a free file sharing site such as ge.tt or Drop Box then post the link to your file back here. Make sure that your sample is an exact replica of your actual workbook. If your data is sensitive then please use dummy data. 

Cheerio,
vcoolio.

vcoolio · Answer

Hello CassYCS,

You don't have a "Completed" sheet which is part of the reason you received the error. The other reason is that you don't have a "K1" sheet but you have a sheet named "K1 Bintulu Port". In Excel, if you wish to use VBA codes, everthing needs to be precise.

I'll get back to you once I've had a chance to properly look through your workbook.

Cheerio,
vcoolio.

vcoolio · Answer

Good evening CassYCS,

I've had a good look through your workbook but I have been left confused.

Which is your main sheet, K1 "Bintulu Port" or "K1 KK Port"?
As I stated in my last post, there isn't a "Completed" sheet. Do you intend to create one or do you intend to use one of the "Closed" sheets.

As for the criteria, rather than a tick mark or an "X", I believe it would make things simpler if you had one criteria in Column Z. For example, a simple "Yes" or "No". You could create drop down boxes in each cell with "Yes" or "No" as the selection criteria.You would only have to change the heading to "Closed (Y/N)". Not over-complicating worksheets makes programming smoother and seamless.

Please advise.

Cheerio,
vcoolio.

vcoolio · Answer

Hello CassYCS,

I've tried to rationalise the sample workbook a little as you can see from the example at the link below.

http://ge.tt/1g46aSr2

I've created  a Completed sheet for the K1 Bintulu Port and a Completed sheet for the K1 KK Port.

Now, each time a "Y" is placed in Column Z and you click away (or press enter or down arrow), the entire row of data is transferred to its relevant Completed sheet. The relevant row of data is then deleted from its source sheet.

I've changed the coding as follows:-

To be placed in the K1 Bintulu Port sheet module:-

Option Compare Text
Private Sub Worksheet_Change(ByVal Target As Range)

Dim ws As Worksheet: Set ws = Sheets("Completed Bintulu Port")

If Intersect(Target, Columns(26)) Is Nothing Then Exit Sub
If Target.Count > 1 Then Exit Sub

Application.ScreenUpdating = False

If Target.Value = "Y" Then
        Target.EntireRow.Copy
        ws.Range("A" & Rows.Count).End(3)(2).PasteSpecial xlPasteAll
        Target.EntireRow.Delete
        ws.Columns.AutoFit
        ws.Rows.AutoFit
End If

Application.CutCopyMode = False
Application.ScreenUpdating = True

End Sub

To implement this code:-

- Right click on the K1 Bintulu Port sheet and select "View Code" from the menu that appears.
- In the big white field that then appears, paste the above code.

To be placed in the K1 KK Port sheet module:-

Option Compare Text
Private Sub Worksheet_Change(ByVal Target As Range)

Dim sh As Worksheet: Set sh = Sheets("Completed KK Port")

If Intersect(Target, Columns(26)) Is Nothing Then Exit Sub
If Target.Count > 1 Then Exit Sub

Application.ScreenUpdating = False

If Target.Value = "Y" Then
        Target.EntireRow.Copy
        sh.Range("A" & Rows.Count).End(3)(2).PasteSpecial xlPasteAll
        Target.EntireRow.Delete
        sh.Columns.AutoFit
        sh.Rows.AutoFit
End If

Application.CutCopyMode = False
Application.ScreenUpdating = True

End Sub

Implement this into the K1 KK Port sheet module using the same steps as for the K1 Bintulu Port sheet.

Test all this in a copy of your actual workbook first but you'll have to rationalise it as per the sample.

Let us know if this works for you.

Cheerio,
vcoolio.

vcoolio · Answer

Hello CassYCS,

You're welcome. I'm glad that I was able to help.

If you study the codes carefully, you should be able to adapt them in future to any more "Port" sheets that you may need to create.

Good luck with it all.

Cheerio,
vcoolio.

vcoolio · Answer

Hello Cass,

If Intersect(Target, Columns(27)) Is Nothing Then Exit Sub 

Your previous posts showed the criteria column as being Column 26 (Z).


ws.Range("A" & Rows.Count).End(3)(2).PasteSpecial xlPasteAll 

Why are you pasting to Column A when all your data starts in Column B?

Perhaps you didn't read my post #12 after all.

Cheerio,
vcoolio.

Copy rows to rows on another worksheet if " ✔ "

7 responses

Similar discussions

Subscribe To Our Newsletter!