Previous Topic Next Topic

Copy a row from one worksheet to another, based on criteria

[Solved/Closed]
Report
-
Posts
1318
Registration date
Thursday July 24, 2014
Status
Moderator
Last seen
September 20, 2021
 -
Hello,



I'm trying to copy rows from my "master" worksheet to another sheet based on criteria in column A. Can I do this? Please help, thanks!
Related:

12 replies

Answer 1 / 12
Posts
1318
Registration date
Thursday July 24, 2014
Status
Moderator
Last seen
September 20, 2021
 238
Hello Wy,

A code like the following may do the task for you:- 

Sub CopyStuff()

Application.ScreenUpdating = False

With ActiveSheet
    .AutoFilterMode = False
    With Range("A1", Range("A" & Rows.Count).End(xlUp))
        .AutoFilter 1, "C"
        On Error Resume Next
        .Offset(1).EntireRow.Copy Sheet2.Range("A" & Rows.Count).End(xlUp).Offset(1)
    End With
    .AutoFilterMode = False
End With

Application.ScreenUpdating = True
Sheet2.Select

End Sub


As I don't know what your criteria is, I've just used the letter "C" for now in the code. Change it to suit yourself.

Following is a link to a test work book I did for another Poster some time ago. I believe it is similar to your situation:-

https://www.dropbox.com/s/b7xmw9eva4ndrpv/Ed.xlsm?dl=0

In the test work book, only those rows with the letter "C" in Column A are transferred to sheet 2. Click on the Copy Data button to see it work.

I hope that this helps.

Cheerio,
vcoolio.
4
Thank you
Thank you

A few words of thanks would be greatly appreciated. Add comment

CCM 2942 users have said thank you to us this month

Answer 2 / 12
Posts
1318
Registration date
Thursday July 24, 2014
Status
Moderator
Last seen
September 20, 2021
 238
Hello Wy,

Ahh, so you are trying to copy data from the Master sheet to multiple sheets instead of just one sheet as per your original post.

Then the following code should do the task for you:- 

Sub TransferAllData()

Application.ScreenUpdating = False

      Dim lRow As Long
      Dim MySheet As String
lRow = Range("A" & Rows.Count).End(xlUp).Row

On Error Resume Next
For Each cell In Range("A2:A" & lRow)
      MySheet = cell.Value
      cell.EntireRow.Copy Sheets(MySheet).Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
      Sheets(MySheet).Columns.AutoFit
Next cell

Columns(1).SpecialCells(4).EntireRow.Copy Sheets("Unassigned").Range("A" & Rows.Count).End(xlUp).Offset(1)
Sheets("Unassigned").Columns.AutoFit

MsgBox "Data transfer completed!", vbExclamation

Application.ScreenUpdating = True
Application.CutCopyMode = False

End Sub


Following is a link to my test work book based on the sample work book that you supplied:-

https://www.dropbox.com/s/8e57x1v8q2y3l23/Wy.xlsm?dl=0

Click on the Transfer Data button to see it work.

Please note that, as you have a vast amount of text in all columns, the code may take 10 - 15 seconds to run.

By " I would also like the rows that are blank to be moved to the "Unassigned" tab.", I assume that you are referring to those rows that do not have a criteria in Column A.

In your work book, copy all the headings from your Master sheet to all the individual sheets.

To implement the code, in your work book click on the Developer tab. Next, over to the far left, click on Visual Basic. This will open the VB Editor. From the menu bar, select Insert and then Module. Now, in the big white field to the right, paste the above code. To run the code, back on your Master sheet, you can insert a button like I have done in the sample and assign the code to the button. You can also press Alt + F8 which will bring up a little Macro window. Select the macro name (in this case "TransferAllData") in the larger white field then click on Run.

I hope that this helps.

Cheerio,
vcoolio.
Answer 3 / 12
Posts
1318
Registration date
Thursday July 24, 2014
Status
Moderator
Last seen
September 20, 2021
 238
Hello again Wy,

Here is another way which will speed up the process:-

New code:- 

Sub FindIDValues()

FindBlanks

Application.ScreenUpdating = False

     Dim IDSearch As String

IDSearch = Sheets("Master").Range("B1")

With Sheets("Master")
    .AutoFilterMode = False
With Range("A1", Range("A" & Rows.Count).End(xlUp))
    .AutoFilter 1, IDSearch
    .Offset(1).EntireRow.Copy
    Sheets(IDSearch).Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
End With

.AutoFilterMode = False

End With

Sheets(IDSearch).Columns.AutoFit
Application.ScreenUpdating = True
Application.CutCopyMode = False
Sheets("Master").Range("B1") = "Enter Search ID"
Sheets(IDSearch).Select

End Sub

Sub FindBlanks()

Application.ScreenUpdating = False

Sheets("Unassigned").UsedRange.Offset(1).ClearContents

With Sheets("Master")
    .AutoFilterMode = False
With Range("A1", Range("A" & Rows.Count).End(xlUp))
    .AutoFilter 1, ""
    .Offset(1).EntireRow.Copy
    Sheets("Unassigned").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
End With

.AutoFilterMode = False

End With

Sheets("Unassigned").Columns.AutoFit
Application.ScreenUpdating = True
Application.CutCopyMode = False

End Sub



Following is a link to my updated test work book:-

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

You'll see in the Master sheet that I have added a "Search ID" box in cell B1.
Enter the required ID exactly as per the sheet name (CB, SC, IA) then click on go. As the code executes, it will also take care of the "Unassigned" rows of data.
You can only do it one ID at a time but it is still alot quicker than the other method.
Let me know how it goes.

Cheerio,
vcoolio.
Answer 4 / 12
Posts
1318
Registration date
Thursday July 24, 2014
Status
Moderator
Last seen
September 20, 2021
 238
Here I am again Wy!

Just to bore you further, the following code should execute in less than one second:- 
Sub FindStuff()

FindStuff2
FindStuff3
FindStuff4

Application.ScreenUpdating = False

Sheets("Unassigned").UsedRange.Offset(1).ClearContents

With Sheets("Master")
    .AutoFilterMode = False
With Range("A1", Range("A" & Rows.Count).End(xlUp))
    .AutoFilter 1, ""
    .Offset(1).EntireRow.Copy
    Sheets("Unassigned").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
End With

.AutoFilterMode = False

End With

Sheets("Unassigned").Columns.AutoFit
Application.ScreenUpdating = True
Application.CutCopyMode = False
MsgBox "All done!", vbExclamation

End Sub
Sub FindStuff2()

Application.ScreenUpdating = False

'Sheets("CB").UsedRange.Offset(1).ClearContents

With Sheets("Master")
    .AutoFilterMode = False
With Range("A1", Range("A" & Rows.Count).End(xlUp))
    .AutoFilter 1, "CB"
    .Offset(1).EntireRow.Copy
    Sheets("CB").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
End With

.AutoFilterMode = False

End With

Sheets("CB").Columns.AutoFit
Application.ScreenUpdating = True
Application.CutCopyMode = False

End Sub
Sub FindStuff3()

Application.ScreenUpdating = False

'Sheets("SC").UsedRange.Offset(1).ClearContents

With Sheets("Master")
    .AutoFilterMode = False
With Range("A1", Range("A" & Rows.Count).End(xlUp))
    .AutoFilter 1, "SC"
    .Offset(1).EntireRow.Copy
    Sheets("SC").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
End With

.AutoFilterMode = False

End With

Sheets("SC").Columns.AutoFit
Application.ScreenUpdating = True
Application.CutCopyMode = False

End Sub
Sub FindStuff4()

Application.ScreenUpdating = False

'Sheets("IA").UsedRange.Offset(1).ClearContents

With Sheets("Master")
    .AutoFilterMode = False
With Range("A1", Range("A" & Rows.Count).End(xlUp))
    .AutoFilter 1, "IA"
    .Offset(1).EntireRow.Copy
    Sheets("IA").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
End With

.AutoFilterMode = False

End With

Sheets("IA").Columns.AutoFit
Application.ScreenUpdating = True
Application.CutCopyMode = False

End Sub

It does the whole task quickly with one click of the button. I'm not sure if you wanted the transferred data in each individual sheet cleared before new data is transferred so I have commented out those lines of code in the above macro (the green print). If you need the data cleared, just remove the apostrophe from the begining of each green line of code.

Here's the updated link to my test work book:-

https://www.dropbox.com/s/5lzii79ciq0ikt8/Wy%283%29.xlsm?dl=0

Cheerio,
vcoolio.
Answer 5 / 12
Posts
1318
Registration date
Thursday July 24, 2014
Status
Moderator
Last seen
September 20, 2021
 238
Hello Wy, 


 So, every time I click the "transfer data" button, will it add to the existing items or will it rerun itself to update the worksheets?


Every time that you click on the button, each sheet that has data transferred to it will grow ( and grow rather large!). Hence my comment in post #5:- 

I'm not sure if you wanted the transferred data in each individual sheet cleared before new data is transferred so I have commented out those lines of code in the above macro (the green print). If you need the data cleared, just remove the apostrophe from the begining of each green line of code.


By clearing the older data from each individual sheet, each individual sheet will be refreshed with any new data which will prevent the sheets from becoming too engorged with data. In the last code I posted above, line 9 does this in the "Unassigned" sheet so you'll notice that the number of rows used in the "Unassigned" sheet remain pretty much static once the code is executed over and over varying only as the number of unassigned rows change in the Master sheet.
But, if you need to keep all data, then your idea of an extra sheet to archive "completed" data would be a good idea. I assume that you would want to enter the word "completed" into Column A of the Master sheet after all the data is transferred so that next time you click on the button, all the older data will be archived in the "Completed" sheet.

But please note that, if you don't clear the older data from each individual sheet, the individual sheets will still grow as new data is added even when the older data from the Master sheet is archived.

Please clarify which way you would like this done and I'll see what I can do for you.

Cheerio,
vcoolio.
Answer 6 / 12
Posts
1318
Registration date
Thursday July 24, 2014
Status
Moderator
Last seen
September 20, 2021
 238
Hello Wy,

Yes, your first task is to remove the apostrophes.

Next, copy/paste the following code into a second module:- 


Sub ArchiveStuff()

Application.ScreenUpdating = False

With Sheets("Master")
    .AutoFilterMode = False
    On Error Resume Next
With Range("A1", Range("A" & Rows.Count).End(xlUp))
    .AutoFilter 1, "Completed"
    .Offset(1).EntireRow.Copy
    Sheets("Completed").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
    .Offset(1).EntireRow.Delete
End With

.AutoFilterMode = False

End With

Sheets("Completed").Columns.AutoFit
Application.ScreenUpdating = True
Application.CutCopyMode = False
Sheets("Completed").Select
End Sub


and assign it to another button (see my updated test work book):-

https://www.dropbox.com/s/5lzii79ciq0ikt8/Wy%283%29.xlsm?dl=0

I've kept the "Archive" code separate to the main code so you can use it randomly, as you wish, to send any rows of data to the "Completed" sheet once "Completed" is placed in Column A of the "Master" sheet and also delete the relevant rows from the "Master" sheet.

Please note:
- "Completed" is case sensitive and
- Ensure the word is placed into the selected cells in Column A before clicking on the "Archive" button.

I hope that this is what you were wanting to do.

Cheerio,
vcoolio.
Report
Posts
1
Registration date
Thursday November 19, 2015
Status
Member
Last seen
November 19, 2015
Hi Vcoolio

This should solve the first part of your query. Replacing 4 procedures with one. 
Option Explicit

Sub MoveStuff()
Dim ar As Variant, I As Integer

ar = [{"CB","SC","IA","Unassigned";"CB","SC","IA",""}]
Application.ScreenUpdating = False

    For I = 1 To UBound(ar, 2)
      Sheets(ar(1, i)).UsedRange.Offset(1).ClearContents
        With Sheet6 'Shee6 is the Master sheet (sht code name - gold)
            .AutoFilterMode = False
                With Range("A1", Range("A" & Rows.Count).End(xlUp))
                    .AutoFilter 1, ar(2, i)
                    .Offset(1).EntireRow.Copy
                     Sheets(ar(1, i)).Range("A" & Rows.Count).End(xlUp)(2).PasteSpecial xlPasteValues
                    ActiveSheet.AutoFilterMode = False
                    Sheets(ar(1, i)).Columns.AutoFit
                End With
        End With
    Next i
    
Application.ScreenUpdating = True
Application.CutCopyMode = False
MsgBox "All done!", vbExclamation

End Sub


Hope this helps.

Take care

Smallman
Report
Posts
1
Registration date
Monday February 20, 2017
Status
Member
Last seen
February 20, 2017
Hello there. I am so pleased I happened upon this site in my exhausting search for what is described through this thread.

To clarify - Is the above code (written by smallman) intended to replace the code you posted November 7th? I understand the Archive code is separate, but just want to clarify that the above is intended to be a full replace of Find Stuff, Find Stuff 2, Find Stuff 3, and Find Stuff 4 macros.

I know SQL and SAS - but know absolutely nothing about VBA so please forgive my lack of knowledge.

Thank you so much,
V -
Report
Posts
1318
Registration date
Thursday July 24, 2014
Status
Moderator
Last seen
September 20, 2021
 238 >
Posts
1
Registration date
Monday February 20, 2017
Status
Member
Last seen
February 20, 2017
Hello there Vmnoble,

Yes, that is correct. One code does the lot (other than the Archive part).

You may also be interested in the following:-

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

Its a code that I supplied to another Poster about twelve months ago. It actually creates the new sheets and transfers the relevant row of data to each individual sheet. It uses an array for the criteria.

Its a good method if you can't be bothered manually creating your sheets!

I hope that you find the information useful. Good luck!

Cheerio,
vcoolio.
Answer 7 / 12
Posts
1318
Registration date
Thursday July 24, 2014
Status
Moderator
Last seen
September 20, 2021
 238
Hello Wy,

I was speaking to the Smallman earlier ( he is just amazing with AutoFilter on large data sets and pretty well all things VBA) and he suggested the above trimmed code.

As you can see, it is very slick and a lot less cumbersome and does the same job.

Please raise your glass to the Smallman for his help on this one.

Let us know how it goes.

Cheerio,
vcoolio.
Answer 8 / 12
Posts
1318
Registration date
Thursday July 24, 2014
Status
Moderator
Last seen
September 20, 2021
 238
Hello Wy,

You're welcome. Glad I (we) could help.

As for writing codes, besides actually going "back to school" and doing a course, you'll find bazillions of tutorials online that will teach you the basics and then build up from there.

Keep an eye on this site as there are many talented Contributors here [I'm still only a junior :-( ] who will help out.

Keep an eye on Smallman's site also (I think its theSmallman.com). He has lots and lots of step by step examples that are well explained.

Hang on to all the codes supplied to you in this thread as they may one day come in handy and you can manipulate them to suit yourself.

Good luck with it all.

Cheerio,
vcoolio.
Answer 9 / 12

Thanks for the info, but I really don't know anything about macros and where I should insert the info. I tried copying off your example and it gave me an error. I'm attaching a sample of my worksheet. I'm trying to copy rows from my "Master" sheet to the corresponding sheets based on criteria in column A. I would also like the rows that are blank to be moved to the "Unassigned" tab. I've learned a lot from these forums but not knowing how to work the codes is a big setback.

Thanks for your time.

https://www.dropbox.com/s/rc28k3pc64t8s3f/demo.xlsx?dl=0
Answer 10 / 12
Posts
3
Registration date
Thursday November 12, 2015
Status
Member
Last seen
November 19, 2015
This is so awesome!!!! Every worksheet you sent kept getting better and better! So, every time I click the "transfer data" button, will it add to the existing items or will it rerun itself to update the worksheets?

I feel like I'm asking too much already, but let's say that I create a new worksheet "completed", Once I enter that word in column "A", how can I have that line deleted from my master once I transfers the data to the new worksheet?

BTW, THANKS!!!! It's amazing the things that can be done!!
Answer 11 / 12
Posts
3
Registration date
Thursday November 12, 2015
Status
Member
Last seen
November 19, 2015
Hello vcoolio,

So my goal is to clear and update with any changes made to the Master sheet. So you're correct, I would want to refresh each sheet, otherwise I would duplicate rows of the same information. Based on your original post, I will remove the apostrophe from the green print.

As for the new sheet "completed", you are correct to assume that the word would be entered into column A. I assume once they are archived to the new sheet, I don't run a risk of these rows being duplicated in the completed sheet every time I run a transfer.

End product will have all lines in master eventually in completed sheet and the remaining sheets will be blank as well, at least that's my goal.

You don't know how much help you have been, thanks again!!!
Answer 12 / 12
Posts
3
Registration date
Thursday November 12, 2015
Status
Member
Last seen
November 19, 2015
vcoolio & smallman,

My worksheet is awesome!!! It does everything I wanted it to do and will make my work so much more efficient. I'm so glad I found this site and so glad I found both of you.

Vcoolio, thank you for spending so much time on this, I truly appreciate it.
I followed your instructions to a "T" and I know how to insert and make a macro work. I still don't know how to write codes, but I know where I can get help. I will mimic this code when I'm ready to separate my data by Districts.

Thanks,

wy
Ask a question

On the same themes